50 lines
3.7 KiB
Mathematica
50 lines
3.7 KiB
Mathematica
PSGWPI1 ;BHAM ISC/MPH,CML-Print AOU Inventory Sheet - CONTINUED ; 18 Jun 93 / 10:40 AM
|
|
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
|
EN1 ; PSGWIDA = DA of inventory being edited
|
|
K PSGW("PO") S PSGPAGE=1,Y=DT X ^DD("DD") S PSGTODAY=Y,LNCNT=0
|
|
I $D(BARFLG) F J=0,1 S @("PSGWBAR"_J)="" I $D(^%ZIS(2,^%ZIS(1,IOS,"SUBTYPE"),"BAR"_J)) S @("PSGWBAR"_J)=^("BAR"_J)
|
|
I $D(BARFLG) S PSGWBARS=PSGWBAR1]""&(PSGWBAR0]"")
|
|
I $D(AOU) S PSGW("PO",100,AOU)="" G START ; Check for single AOU print
|
|
F SK=0:0 S SK=$O(^PSI(58.19,PSGWIDA,1,"C",SK)) Q:SK'>0 F J=0:0 S J=$O(^PSI(58.19,PSGWIDA,1,"C",SK,J)) Q:J'>0 S PSGW("PO",SK,J)=""
|
|
START S PSGWIN=$P(^PSI(58.19,PSGWIDA,0),"^",1)
|
|
WLOOP F PSGSORTK=0:0 S PSGSORTK=$O(PSGW("PO",PSGSORTK)) Q:PSGSORTK'>0 F PSGDA=0:0 S PSGDA=$O(PSGW("PO",PSGSORTK,PSGDA)) Q:PSGDA'>0 D SIN,WENT
|
|
END W:$D(STKCHG) !!,"* Indicates change in stock level"
|
|
I $E(IOST)'="C" W @IOF
|
|
Q
|
|
;
|
|
SIN ;Sort the ward item list
|
|
K ^PSI(58.19,"AINV",PSGWIDA,PSGDA) S (PSGNT,J)=0,PSGTN="" F I=0:0 S I=$O(^PSI(58.19,PSGWIDA,1,PSGDA,1,I)) Q:I'>0 S PSGTN=PSGTN_I_",",PSGNT=PSGNT+1
|
|
SINL S J=$O(^PSI(58.1,PSGDA,1,J)) Q:J'>0 S K=^(J,0)
|
|
F I=1:1:PSGNT I $S($D(^PSI(58.1,PSGDA,1,J,2,$P(PSGTN,",",I))):1,$D(^PSI(58.16,$P(PSGTN,",",I),0)):$P(^(0),"^")="ALL",1:0) D CHKINA G:$T SINL
|
|
G SINL
|
|
;
|
|
CHKINA I $S('$D(^PSI(58.1,PSGDA,1,J,"I")):1,$O(^("I",PSGWDT))>0:1,$P(^PSI(58.1,PSGDA,1,J,0),"^",10)="Y":1,1:0) D LOC S ^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR)=+J_"^"_$P(K,"^",1,2)
|
|
Q
|
|
;
|
|
LOC ;Build item address
|
|
S K1=$P(K,"^",8) F NN=1:1:3 S @("PSG"_NN)=$S($P(K1,",",NN)]"":$P(K1,",",NN),1:" ")
|
|
S PSGDR=$S($D(^PSDRUG(+K,0))#2:$P(^(0),"^",1),1:+K)
|
|
S PSGTYP=$S($D(^PSI(58.16,$P(PSGTN,",",I),0)):$P(^(0),"^"),1:"TYPE HAS BEEN DELETED")
|
|
I '$D(^PSI(58.1,PSGDA,1,J,1,PSGWIDA,0)) D EN2^PSGWPI2
|
|
Q
|
|
;
|
|
WENT S PSG1="" I $D(^PSI(58.19,"AINV",PSGWIDA,PSGDA)) D EN1^PSGWPI2
|
|
PSG1 S PSG1=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1)) Q:PSG1="" W !,?17,PSG1 S PSG2="",EXP=$O(^PSI(58.17,"B",PSG1,0)) W:EXP>0 " ",$P(^PSI(58.17,EXP,0),"^",3) S LNCNT=LNCNT+1
|
|
PSG2 S PSG2=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2)) G PSG1:PSG2="" S PSG3=""
|
|
PSG3 S PSG3=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3)) G PSG2:PSG3="" S PSGTYP="" W !,?1,PSG2,$S(PSG3'=" ":","_PSG3,PSG3="":" ",1:"") S LNCNT=LNCNT+1
|
|
PSGTYP I $D(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,"ALL")) S TYPE="" F Q=0:0 S TYPE=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,TYPE)) Q:TYPE="" I TYPE'="ALL" K ^(TYPE)
|
|
S PSGTYP=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP)) G PSG3:PSGTYP="" S PSGDR="" S LFC=$S($X>7:"!?7",1:"?7") W:PSGTYP'="ALL" @LFC,PSGTYP
|
|
PSGDR S PSGDR=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR)) G PSGTYP:PSGDR="" S PSGDDA=+^(PSGDR),DRGDA=+$P(^(PSGDR),"^",2),STLEV=$P(^(PSGDR),"^",3),LOC=^PSI(58.1,PSGDA,1,PSGDDA,0)
|
|
I $D(BARFLG) D:LNCNT>45 EN1^PSGWPI2 D BARWRT^PSGWPI2 G PSGDR
|
|
D:$Y+5>IOSL EN1^PSGWPI2
|
|
PNT W !,?10,PSGDR I $P(LOC,"^",5)="Y" W ?50,"*" S STKCHG="Y" S $P(^PSI(58.1,PSGDA,1,PSGDDA,0),"^",5)=""
|
|
I (($P(LOC,"^",3)'>PSGWDT)&($P(LOC,"^",10)="Y")) W ?50,"*" S PSGINAD="Y" S $P(^PSI(58.1,PSGDA,1,PSGDDA,0),"^",10)=""
|
|
W ?51,$J(STLEV,3)
|
|
QCODE F MH=0:0 S MH=$O(^PSDRUG($P(^PSI(58.1,PSGDA,1,PSGDDA,0),"^",1),1,MH)) Q:MH'>0 I $P(^(MH,0),"^",3) W ?58,$E($P(^(0),"^",1),1,8) Q
|
|
W ?66,"_____"
|
|
I $P(PSGWSITE,"^",5) W ?75,$S($P(LOC,"^",11)]"":$J($P(LOC,"^",11),5),1:" "),?86,$S(+$P(LOC,"^",12):$J($P(LOC,"^",12),5),1:" "),?98,"______"
|
|
I $P(PSGWSITE,"^",6) S TAB1=$S($P(PSGWSITE,"^",5):109,1:74),TAB2=$S($P(PSGWSITE,"^",5):118,1:82) W ?TAB1,"______",?TAB2,"E O D C"
|
|
I $D(^PSI(58.1,PSGDA,1,PSGDDA,"EXP")) S Y=^("EXP") I Y X ^DD("DD") W !?14,"Expiration Date: ",Y
|
|
I $D(PSGINAD) W !?14,"*Inactivated item, pull existing stock" K PSGINAD
|
|
G PSGDR
|