- 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
- 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
