PSGWEDI ;BHAM ISC/GRK,CML-Enter/Edit of AOU Inventory Values ; 17 Jun 93 / 10:35 AM
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
I '$D(PSGWSITE) D ^PSGWSET Q:'$D(PSGWSITE) S PSGWFLG=1
I $P(PSGWSITE,"^",5) W !!?5,"You may not enter on-hand amounts because you have the ""Merge",!?5,"Inventory Sheet and Pick List"" site parameter set to ""YES""." Q
S DIC="^PSI(58.19,",DIC(0)="QEAMNZ",DIC("A")="SELECT DATE/TIME FOR INVENTORY: " D ^DIC K DIC Q:Y<0 S PSGWIDA=+Y
;
EN1 ; PSGWIDA = DA of inventory being edited
K PSGW("PO") S PSGWV="AMIS COMPILE FLAG"
F SK=0:0 S SK=$O(^PSI(58.19,PSGWIDA,1,"C",SK)) Q:'SK F J=0:0 S J=$O(^PSI(58.19,PSGWIDA,1,"C",SK,J)) Q:'J S PSGW("PO",SK,J)=""
S (PSGWADT,PSGWIN)=$P(^PSI(58.19,PSGWIDA,0),"^",1),PSGWCAT="A",FLG=0,AMISFL=0
WLOOP F PSGSORTK=0:0 S PSGSORTK=$O(PSGW("PO",PSGSORTK)) Q:'PSGSORTK Q:FLG F PSGDA=0:0 S PSGDA=$O(PSGW("PO",PSGSORTK,PSGDA)) Q:'PSGDA D WENT Q:FLG S AMISFL=0
END D CHKGLOB K PSGW("PO"),PSG1,PSG2,PSG3,PSGWACT,PSGWAOUN,PSGWDA,PSGDDA,PSGWDN,PSGDR,PSGWOD,PSGSORTK,PSGWIN,PSGWN,PSGX,PSGDA,PSGTYP,PSGWIDA,SK,WN,X,Y,I,J,K,L,M,MIN,N,P1,P2,P3,RELEV,TYP,DRUG,A,PSGWDRG,PSGWADT,PSGWCAT,PSGWQD,FLG,PSGWV,DIC
K AMISFL,PSGWAOU,KEY,DA,K1,GRP,LP,PC,%,%Y,C K:$D(PSGWFLG) PSGWFLG,PSGWSITE Q
WENT S PSGWN=$S($D(^PSI(58.1,PSGDA,0)):$P(^(0),"^",1),1:""),DIC("B")=PSGWN
W ! S DIC="^PSI(58.19,PSGWIDA,1,",DIC(0)="AEQNMZ" D ^DIC K DIC S (PSGWDA,DA,PSGWAOU)=+Y,PSGWAOUN=$P(Y,"^",2) S:Y<0 FLG=1 Q:Y<0 S:($P(^PSI(58.1,PSGWDA,0),"^",3)'=1)&($P(PSGWSITE,"^",25)=1) AMISFL=1
S PSG1=""
PSG1 S PSG1=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1)) Q:PSG1="" S PSG2=""
PSG2 S PSG2=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2)) G PSG1:PSG2="" S PSG3=""
PSG3 S PSG3=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3)) G PSG2:PSG3="" S PSGTYP=""
PSGTYP S PSGTYP=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,PSGTYP)) G PSG3:PSGTYP="" S PSGDR=""
PSGDR S PSGDR=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR)) G PSGTYP:PSGDR="" S PSGDDA=+^(PSGDR),PSGWDN=$P(^(PSGDR),"^",2)
W !!," ITEM: ",PSGDR
I $D(^PSI(58.1,PSGWDA,1,PSGDDA,1,PSGWIDA,0)) S A=^(0)
E D EN3^PSGWEDI1
F J=1:1:6 S PSGX(J)=$P(A,"^",J)
ONH W !,"ON-HAND: " W:PSGX(6)'="" PSGX(6),"//" R X:DTIME S:'$T FLG=1 Q:'$T W:PSGX(6)=""&(X="") PSGX(2) S:X="" X=PSGX(6) Q:X="^" S:X="" X=PSGX(2) I X["^" S PSGWDRG=X D EN1^PSGWEDI1 G:DA<0 ONH G PSGDR
I "?"[$E(X)!(X<0)!(X>9999)!(X'?1N.N) W *7,!,"Enter quantity presently on-hand in the ward at the time of inventory.",!,"Must be a number between 0 and 9999." G ONH
S PSGX(6)=$S(X="@":"",1:X),RELEV=$P(^PSI(58.1,PSGWDA,1,PSGDDA,0),"^",11),MIN=$P(^(0),"^",12) D DISP
DUMP S (PSGWOD,PSGWACT,PSGWQD)=PSGX(5) I (AMISFL=1)&(PSGWQD'=0) S ^PSI(58.5,"AMIS",$H,PSGWADT,PSGWCAT,PSGWAOU,PSGWDN,PSGWQD)=""
S ^(PSGDR)=$P(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",1,3)_"^"_PSGX(5)
S A="" F J=1:1:6 S A=A_PSGX(J)_"^"
S ^(0)=A_$P(^PSI(58.1,PSGWDA,1,PSGDDA,1,PSGWIDA,0),"^",7,999)
D:PSGX(5)'=0 ^PSGWFLBO G PSGDR
;
CHKGLOB ;Set piece 4 of global to 0 if null.
AOU S (P1,P2,P3,TYP,DRUG)=0 F I=0:0 S I=$O(^PSI(58.19,"AINV",PSGWIDA,I)) Q:'I D P1
Q
P1 F J=0:0 S P1=$O(^PSI(58.19,"AINV",PSGWIDA,I,P1)) Q:P1="" D P2
Q
P2 F K=0:0 S P2=$O(^PSI(58.19,"AINV",PSGWIDA,I,P1,P2)) Q:P2="" D P3
Q
P3 F L=0:0 S P3=$O(^PSI(58.19,"AINV",PSGWIDA,I,P1,P2,P3)) Q:P3="" D TYP
Q
TYP F M=0:0 S TYP=$O(^PSI(58.19,"AINV",PSGWIDA,I,P1,P2,P3,TYP)) Q:TYP="" D DRUG
Q
DRUG F N=0:0 S DRUG=$O(^PSI(58.19,"AINV",PSGWIDA,I,P1,P2,P3,TYP,DRUG)) Q:DRUG="" I $P(^(DRUG),"^",4)="" S $P(^(DRUG),"^",4)=0
Q
DISP ;CALCULATE DISPENSE AMT
S PSGX(5)=PSGX(2)-PSGX(6) S:PSGX(5)<0 PSGX(5)=0 I RELEV']"" Q
I PSGX(6)>+RELEV S PSGX(5)=0 Q
I PSGX(5)<+MIN S PSGX(5)=+MIN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWEDI 3763 printed Apr 09, 2024@20:44:39 Page 2
PSGWEDI ;BHAM ISC/GRK,CML-Enter/Edit of AOU Inventory Values ; 17 Jun 93 / 10:35 AM
+1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
+2 IF '$DATA(PSGWSITE)
DO ^PSGWSET
if '$DATA(PSGWSITE)
QUIT
SET PSGWFLG=1
+3 IF $PIECE(PSGWSITE,"^",5)
WRITE !!?5,"You may not enter on-hand amounts because you have the ""Merge",!?5,"Inventory Sheet and Pick List"" site parameter set to ""YES""."
QUIT
+4 SET DIC="^PSI(58.19,"
SET DIC(0)="QEAMNZ"
SET DIC("A")="SELECT DATE/TIME FOR INVENTORY: "
DO ^DIC
KILL DIC
if Y<0
QUIT
SET PSGWIDA=+Y
+5 ;
EN1 ; PSGWIDA = DA of inventory being edited
+1 KILL PSGW("PO")
SET PSGWV="AMIS COMPILE FLAG"
+2 FOR SK=0:0
SET SK=$ORDER(^PSI(58.19,PSGWIDA,1,"C",SK))
if 'SK
QUIT
FOR J=0:0
SET J=$ORDER(^PSI(58.19,PSGWIDA,1,"C",SK,J))
if 'J
QUIT
SET PSGW("PO",SK,J)=""
+3 SET (PSGWADT,PSGWIN)=$PIECE(^PSI(58.19,PSGWIDA,0),"^",1)
SET PSGWCAT="A"
SET FLG=0
SET AMISFL=0
WLOOP FOR PSGSORTK=0:0
SET PSGSORTK=$ORDER(PSGW("PO",PSGSORTK))
if 'PSGSORTK
QUIT
if FLG
QUIT
FOR PSGDA=0:0
SET PSGDA=$ORDER(PSGW("PO",PSGSORTK,PSGDA))
if 'PSGDA
QUIT
DO WENT
if FLG
QUIT
SET AMISFL=0
END DO CHKGLOB
KILL PSGW("PO"),PSG1,PSG2,PSG3,PSGWACT,PSGWAOUN,PSGWDA,PSGDDA,PSGWDN,PSGDR,PSGWOD,PSGSORTK,PSGWIN,PSGWN,PSGX,PSGDA,PSGTYP,PSGWIDA,SK,WN,X,Y,I,J,K,L,M,MIN,N,P1,P2,P3,RELEV,TYP,DRUG,A,PSGWDRG,PSGWADT,PSGWCAT,PSGWQD,FLG,PSGWV,DIC
+1 KILL AMISFL,PSGWAOU,KEY,DA,K1,GRP,LP,PC,%,%Y,C
if $DATA(PSGWFLG)
KILL PSGWFLG,PSGWSITE
QUIT
WENT SET PSGWN=$SELECT($DATA(^PSI(58.1,PSGDA,0)):$PIECE(^(0),"^",1),1:"")
SET DIC("B")=PSGWN
+1 WRITE !
SET DIC="^PSI(58.19,PSGWIDA,1,"
SET DIC(0)="AEQNMZ"
DO ^DIC
KILL DIC
SET (PSGWDA,DA,PSGWAOU)=+Y
SET PSGWAOUN=$PIECE(Y,"^",2)
if Y<0
SET FLG=1
if Y<0
QUIT
if ($PIECE(^PSI(58.1,PSGWDA,0),"^",3)'=1)&($PIECE(PSGWSITE,"^",25)=1)
SET AMISFL=1
+2 SET PSG1=""
PSG1 SET PSG1=$ORDER(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1))
if PSG1=""
QUIT
SET PSG2=""
PSG2 SET PSG2=$ORDER(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2))
if PSG2=""
GOTO PSG1
SET PSG3=""
PSG3 SET PSG3=$ORDER(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3))
if PSG3=""
GOTO PSG2
SET PSGTYP=""
PSGTYP SET PSGTYP=$ORDER(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,PSGTYP))
if PSGTYP=""
GOTO PSG3
SET PSGDR=""
PSGDR SET PSGDR=$ORDER(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR))
if PSGDR=""
GOTO PSGTYP
SET PSGDDA=+^(PSGDR)
SET PSGWDN=$PIECE(^(PSGDR),"^",2)
+1 WRITE !!," ITEM: ",PSGDR
+2 IF $DATA(^PSI(58.1,PSGWDA,1,PSGDDA,1,PSGWIDA,0))
SET A=^(0)
+3 IF '$TEST
DO EN3^PSGWEDI1
+4 FOR J=1:1:6
SET PSGX(J)=$PIECE(A,"^",J)
ONH WRITE !,"ON-HAND: "
if PSGX(6)'=""
WRITE PSGX(6),"//"
READ X:DTIME
if '$TEST
SET FLG=1
if '$TEST
QUIT
if PSGX(6)=""&(X="")
WRITE PSGX(2)
if X=""
SET X=PSGX(6)
if X="^"
QUIT
if X=""
SET X=PSGX(2)
IF X["^"
SET PSGWDRG=X
DO EN1^PSGWEDI1
if DA<0
GOTO ONH
GOTO PSGDR
+1 IF "?"[$EXTRACT(X)!(X<0)!(X>9999)!(X'?1N.N)
WRITE *7,!,"Enter quantity presently on-hand in the ward at the time of inventory.",!,"Must be a number between 0 and 9999."
GOTO ONH
+2 SET PSGX(6)=$SELECT(X="@":"",1:X)
SET RELEV=$PIECE(^PSI(58.1,PSGWDA,1,PSGDDA,0),"^",11)
SET MIN=$PIECE(^(0),"^",12)
DO DISP
DUMP SET (PSGWOD,PSGWACT,PSGWQD)=PSGX(5)
IF (AMISFL=1)&(PSGWQD'=0)
SET ^PSI(58.5,"AMIS",$HOROLOG,PSGWADT,PSGWCAT,PSGWAOU,PSGWDN,PSGWQD)=""
+1 SET ^(PSGDR)=$PIECE(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",1,3)_"^"_PSGX(5)
+2 SET A=""
FOR J=1:1:6
SET A=A_PSGX(J)_"^"
+3 SET ^(0)=A_$PIECE(^PSI(58.1,PSGWDA,1,PSGDDA,1,PSGWIDA,0),"^",7,999)
+4 if PSGX(5)'=0
DO ^PSGWFLBO
GOTO PSGDR
+5 ;
CHKGLOB ;Set piece 4 of global to 0 if null.
AOU SET (P1,P2,P3,TYP,DRUG)=0
FOR I=0:0
SET I=$ORDER(^PSI(58.19,"AINV",PSGWIDA,I))
if 'I
QUIT
DO P1
+1 QUIT
P1 FOR J=0:0
SET P1=$ORDER(^PSI(58.19,"AINV",PSGWIDA,I,P1))
if P1=""
QUIT
DO P2
+1 QUIT
P2 FOR K=0:0
SET P2=$ORDER(^PSI(58.19,"AINV",PSGWIDA,I,P1,P2))
if P2=""
QUIT
DO P3
+1 QUIT
P3 FOR L=0:0
SET P3=$ORDER(^PSI(58.19,"AINV",PSGWIDA,I,P1,P2,P3))
if P3=""
QUIT
DO TYP
+1 QUIT
TYP FOR M=0:0
SET TYP=$ORDER(^PSI(58.19,"AINV",PSGWIDA,I,P1,P2,P3,TYP))
if TYP=""
QUIT
DO DRUG
+1 QUIT
DRUG FOR N=0:0
SET DRUG=$ORDER(^PSI(58.19,"AINV",PSGWIDA,I,P1,P2,P3,TYP,DRUG))
if DRUG=""
QUIT
IF $PIECE(^(DRUG),"^",4)=""
SET $PIECE(^(DRUG),"^",4)=0
+1 QUIT
DISP ;CALCULATE DISPENSE AMT
+1 SET PSGX(5)=PSGX(2)-PSGX(6)
if PSGX(5)<0
SET PSGX(5)=0
IF RELEV']""
QUIT
+2 IF PSGX(6)>+RELEV
SET PSGX(5)=0
QUIT
+3 IF PSGX(5)<+MIN
SET PSGX(5)=+MIN
+4 QUIT
