PSGWPL0 ;BHAM ISC/MPH,PTD,CML-Print AOU Inventory Pick List - CONTINUED ; 09 Feb 93 / 10:08 AM
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
ENQ ;ENTRY POINT WHEN QUEUED
S MSGFLG=0
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)=""
S PSGWIN=$P(^PSI(58.19,PSGWIDA,0),"^"),DISPFL=""
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:NOPRT=0 WENT
W:(DISPFL="")&(NOPRT=0) !!,"NO STOCK TO BE DISPENSED FOR THIS INVENTORY." I (NOPRT=0)&(DISPFL'="") D ^PSGWPL1
DONE I $E(IOST)'="C" W @IOF
END W ! K G,PSG1,PSG2,PSG3,PSG1FLG,PSG3FLG,PSGTYFLG,PSGBON,PSGCS,PSGDDA,PSGDN,PSGSORTK,PSGWIDA,PSGWIN,PSGW("PO"),PSGBOT,PSGTYP,PSGWGRP,PSGWLP,PSGWPC,PSGDA,PSGDR,PSGPAGE,PSGTODAY,PSGST
K ^TMP("PSGWDL",$J),MSGFLG,ZTSK,I,J,K,K1,DISPFL,NOPRT,EXP,GRP,AOUFLG,LL,LP,PC,SY,SK,L,Y,X,X1,PSGDL1,PSGDL2,PSGDL3,IO("Q") D ^%ZISC
K:$D(PSGWFLG) PSGWSITE,PSGWFLG
S:$D(ZTQUEUED) ZTREQ="@" Q
;
WENT ;Sort the ward item list to determine content of Pick List
S PSG1="" I $D(^PSI(58.19,"AINV",PSGWIDA,PSGDA)) S AOUFLG=1
PSG1 S PSG1=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1)) Q:PSG1="" S PSG1FLG=1,PSG2="",EXP=$O(^PSI(58.17,"B",PSG1,0))
PSG2 S PSG2=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2)) G:PSG2="" PSG1 S PSG3=""
PSG3 S PSG3=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3)) G:PSG3="" PSG2 S PSGTYP="",PSG3FLG=1
PSGTYP S PSGTYP=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP)) G:PSGTYP="" PSG3 S PSGDR="",PSGTYFLG=1
PSGDR S PSGDR=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR)) D:PSGDR'="" CHKDISP Q:NOPRT=1 G:PSGDR="" PSGTYP S PSGDDA=$P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^")
I $P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",4)'>0 G PSGDR
I $P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",4)>0 D LOC S DISPFL=1
S PSGDN=+^PSI(58.1,PSGDA,1,PSGDDA,0)
BACKOD S PSGBOT=0,Y=$O(^PSI(58.3,"B",PSGDN,0)) G:Y="" PNT S PSGBON=+Y
F J=0:0 S J=$S($D(^PSI(58.3,PSGBON,1,PSGDA,1,J)):$O(^(J)),1:0) Q:J'>0 S:$S($P(^(J,0),"^",5)="":1,$P(^(0),"^",5)'<PSGWIN:1,1:0) PSGBOT=PSGBOT+$P(^(0),"^",2)
PNT I ($Y+5>IOSL)!($D(AOUFLG)) D EN2^PSGWPL K AOUFLG
I $D(PSG1FLG) W !,?17,PSG1 W:EXP>0 " ",$P(^PSI(58.17,EXP,0),"^",3) K PSG1FLG
I $D(PSG3FLG) W !,?1,PSG2,$S(PSG3'=" ":","_PSG3,PSG3="":" ",1:"") K PSG3FLG
I $D(PSGTYFLG) S LL=$S($X>7:"!?7",1:"?7") W:PSGTYP'="ALL" @LL,PSGTYP K PSGTYFLG
W !,?10,PSGDR,?51,$J($P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",3),3) S MSGFLG=1
QCODE F SY=0:0 S SY=$O(^PSDRUG(PSGDN,1,SY)) Q:SY'>0 I $P(^(SY,0),"^",3) W ?58,$E($P(^(0),"^"),1,10) Q
W ?71,$J($P(^PSI(58.1,PSGDA,1,PSGDDA,1,PSGWIDA,0),"^",6),3),?91,$J(PSGBOT,3),?105,$J($P(^(0),"^",5),3),?115,"_________"
CSUB S PSGCS=$S($D(^PSDRUG(PSGDN,0))#2:$P(^(0),"^",3),1:"") W:PSGCS["A" !!,?83,"Controlled Substance ____________________________",!
G PSGDR
;
CHKDISP ;Has quantity dispensed been entered for inventory?
I $P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",4)="" S NOPRT=1 D MSG
Q
;
LOC ;Build item address
S J=$P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^"),K=$P(^(PSGDR),"^",2)
S K1=$S($D(^PSDRUG(+K,"PSG"))#2:$P(^("PSG"),"^"),1:"") F I=1:1:3 S @("PSGDL"_I)=$S($P(K1,",",I)]"":$P(K1,",",I),1:" ")
I $D(^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR)) S ^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR)=$P(^(PSGDR),"^")+$P(^PSI(58.1,PSGDA,1,J,1,PSGWIDA,0),"^",5)
E S ^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR)=$P(^PSI(58.1,PSGDA,1,J,1,PSGWIDA,0),"^",5)
S ^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR,PSGDA)=$P(^PSI(58.1,PSGDA,1,J,1,PSGWIDA,0),"^",5)
Q
MSG ;Warning msg for no quantities
W !,$S(MSGFLG:"Pick List cannot continue printing.",1:"Pick List cannot be printed."),!,"On-hand quantity or quantity dispensed not entered.",!,"Use Input AOU Inventory OR Enter/Edit Quantity Dispensed." Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWPL0 4036 printed Apr 09, 2024@20:45:14 Page 2
PSGWPL0 ;BHAM ISC/MPH,PTD,CML-Print AOU Inventory Pick List - CONTINUED ; 09 Feb 93 / 10:08 AM
+1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
ENQ ;ENTRY POINT WHEN QUEUED
+1 SET MSGFLG=0
+2 FOR SK=0:0
SET SK=$ORDER(^PSI(58.19,PSGWIDA,1,"C",SK))
if SK'>0
QUIT
FOR J=0:0
SET J=$ORDER(^PSI(58.19,PSGWIDA,1,"C",SK,J))
if J'>0
QUIT
SET PSGW("PO",SK,J)=""
+3 SET PSGWIN=$PIECE(^PSI(58.19,PSGWIDA,0),"^")
SET DISPFL=""
WLOOP FOR PSGSORTK=0:0
SET PSGSORTK=$ORDER(PSGW("PO",PSGSORTK))
if PSGSORTK'>0
QUIT
FOR PSGDA=0:0
SET PSGDA=$ORDER(PSGW("PO",PSGSORTK,PSGDA))
if PSGDA'>0
QUIT
if NOPRT=0
DO WENT
+1 if (DISPFL="")&(NOPRT=0)
WRITE !!,"NO STOCK TO BE DISPENSED FOR THIS INVENTORY."
IF (NOPRT=0)&(DISPFL'="")
DO ^PSGWPL1
DONE IF $EXTRACT(IOST)'="C"
WRITE @IOF
END WRITE !
KILL G,PSG1,PSG2,PSG3,PSG1FLG,PSG3FLG,PSGTYFLG,PSGBON,PSGCS,PSGDDA,PSGDN,PSGSORTK,PSGWIDA,PSGWIN,PSGW("PO"),PSGBOT,PSGTYP,PSGWGRP,PSGWLP,PSGWPC,PSGDA,PSGDR,PSGPAGE,PSGTODAY,PSGST
+1 KILL ^TMP("PSGWDL",$JOB),MSGFLG,ZTSK,I,J,K,K1,DISPFL,NOPRT,EXP,GRP,AOUFLG,LL,LP,PC,SY,SK,L,Y,X,X1,PSGDL1,PSGDL2,PSGDL3,IO("Q")
DO ^%ZISC
+2 if $DATA(PSGWFLG)
KILL PSGWSITE,PSGWFLG
+3 if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+4 ;
WENT ;Sort the ward item list to determine content of Pick List
+1 SET PSG1=""
IF $DATA(^PSI(58.19,"AINV",PSGWIDA,PSGDA))
SET AOUFLG=1
PSG1 SET PSG1=$ORDER(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1))
if PSG1=""
QUIT
SET PSG1FLG=1
SET PSG2=""
SET EXP=$ORDER(^PSI(58.17,"B",PSG1,0))
PSG2 SET PSG2=$ORDER(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2))
if PSG2=""
GOTO PSG1
SET PSG3=""
PSG3 SET PSG3=$ORDER(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3))
if PSG3=""
GOTO PSG2
SET PSGTYP=""
SET PSG3FLG=1
PSGTYP SET PSGTYP=$ORDER(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP))
if PSGTYP=""
GOTO PSG3
SET PSGDR=""
SET PSGTYFLG=1
PSGDR SET PSGDR=$ORDER(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR))
if PSGDR'=""
DO CHKDISP
if NOPRT=1
QUIT
if PSGDR=""
GOTO PSGTYP
SET PSGDDA=$PIECE(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^")
+1 IF $PIECE(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",4)'>0
GOTO PSGDR
+2 IF $PIECE(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",4)>0
DO LOC
SET DISPFL=1
+3 SET PSGDN=+^PSI(58.1,PSGDA,1,PSGDDA,0)
BACKOD SET PSGBOT=0
SET Y=$ORDER(^PSI(58.3,"B",PSGDN,0))
if Y=""
GOTO PNT
SET PSGBON=+Y
+1 FOR J=0:0
SET J=$SELECT($DATA(^PSI(58.3,PSGBON,1,PSGDA,1,J)):$ORDER(^(J)),1:0)
if J'>0
QUIT
if $SELECT($PIECE(^(J,0),"^",5)=""
SET PSGBOT=PSGBOT+$PIECE(^(0),"^",2)
PNT IF ($Y+5>IOSL)!($DATA(AOUFLG))
DO EN2^PSGWPL
KILL AOUFLG
+1 IF $DATA(PSG1FLG)
WRITE !,?17,PSG1
if EXP>0
WRITE " ",$PIECE(^PSI(58.17,EXP,0),"^",3)
KILL PSG1FLG
+2 IF $DATA(PSG3FLG)
WRITE !,?1,PSG2,$SELECT(PSG3'=" ":","_PSG3,PSG3="":" ",1:"")
KILL PSG3FLG
+3 IF $DATA(PSGTYFLG)
SET LL=$SELECT($X>7:"!?7",1:"?7")
if PSGTYP'="ALL"
WRITE @LL,PSGTYP
KILL PSGTYFLG
+4 WRITE !,?10,PSGDR,?51,$JUSTIFY($PIECE(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",3),3)
SET MSGFLG=1
QCODE FOR SY=0:0
SET SY=$ORDER(^PSDRUG(PSGDN,1,SY))
if SY'>0
QUIT
IF $PIECE(^(SY,0),"^",3)
WRITE ?58,$EXTRACT($PIECE(^(0),"^"),1,10)
QUIT
+1 WRITE ?71,$JUSTIFY($PIECE(^PSI(58.1,PSGDA,1,PSGDDA,1,PSGWIDA,0),"^",6),3),?91,$JUSTIFY(PSGBOT,3),?105,$JUSTIFY($PIECE(^(0),"^",5),3),?115,"_________"
CSUB SET PSGCS=$SELECT($DATA(^PSDRUG(PSGDN,0))#2:$PIECE(^(0),"^",3),1:"")
if PSGCS["A"
WRITE !!,?83,"Controlled Substance ____________________________",!
+1 GOTO PSGDR
+2 ;
CHKDISP ;Has quantity dispensed been entered for inventory?
+1 IF $PIECE(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",4)=""
SET NOPRT=1
DO MSG
+2 QUIT
+3 ;
LOC ;Build item address
+1 SET J=$PIECE(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^")
SET K=$PIECE(^(PSGDR),"^",2)
+2 SET K1=$SELECT($DATA(^PSDRUG(+K,"PSG"))#2:$PIECE(^("PSG"),"^"),1:"")
FOR I=1:1:3
SET @("PSGDL"_I)=$SELECT($PIECE(K1,",",I)]"":$PIECE(K1,",",I),1:" ")
+3 IF $DATA(^TMP("PSGWDL",$JOB,PSGDL1,PSGDL2,PSGDL3,PSGDR))
SET ^TMP("PSGWDL",$JOB,PSGDL1,PSGDL2,PSGDL3,PSGDR)=$PIECE(^(PSGDR),"^")+$PIECE(^PSI(58.1,PSGDA,1,J,1,PSGWIDA,0),"^",5)
+4 IF '$TEST
SET ^TMP("PSGWDL",$JOB,PSGDL1,PSGDL2,PSGDL3,PSGDR)=$PIECE(^PSI(58.1,PSGDA,1,J,1,PSGWIDA,0),"^",5)
+5 SET ^TMP("PSGWDL",$JOB,PSGDL1,PSGDL2,PSGDL3,PSGDR,PSGDA)=$PIECE(^PSI(58.1,PSGDA,1,J,1,PSGWIDA,0),"^",5)
+6 QUIT
MSG ;Warning msg for no quantities
+1 WRITE !,$SELECT(MSGFLG:"Pick List cannot continue printing.",1:"Pick List cannot be printed."),!,"On-hand quantity or quantity dispensed not entered.",!,"Use Input AOU Inventory OR Enter/Edit Quantity Dispensed."
QUIT
