PSGWPL1.m

PSGWPL1 ;BHAM ISC/MPH,CML-Print AOU Inventory Pick List - CONTINUED ; 17 Jun 93 / 10:39 AM

 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94

 S PSGDL1=""

 I $P(^PSI(58.19,PSGWIDA,0),"^",4)="" W !!,"AOU INVENTORY GROUP MISSING" G END

 D HDGP

PSGDL1 S PSGDL1=$O(^TMP("PSGWDL",$J,PSGDL1)) G:PSGDL1="" END W !,?17,PSGDL1 S PSGDL2="",EXP=$O(^PSI(58.17,"B",PSGDL1,0)) W:EXP>0 " ",$P(^PSI(58.17,EXP,0),"^",3)

PSGDL2 S PSGDL2=$O(^TMP("PSGWDL",$J,PSGDL1,PSGDL2)) G PSGDL1:PSGDL2="" S PSGDL3=""

PSGDL3 S PSGDL3=$O(^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3)) G PSGDL2:PSGDL3="" S PSGDR=""

PSGDR S PSGDR=$O(^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR)) G PSGDL3:PSGDR="" S PSGDA=""

 D:$Y+5>IOSL HDGP

PNT W !,?1,PSGDL2,$S(PSGDL3'=" ":","_PSGDL3,PSGDL3="":" ",1:""),?10,PSGDR

PSGDA I $D(PSGST) S PSGDA=$O(^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR,PSGDA)) W:PSGDA="" ?52,"-------------------------",!?52,"TOTAL ",?73,$J(+^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR),3),?90,"______",! G:PSGDA="" PSGDR

 I $D(PSGST) W ?52,$P(^PSI(58.1,PSGDA,0),"^",1),?73,$J(+^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR,PSGDA),3),!

 E  W ?73,$J(+^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR),3),?90,"______"

 G PSGDR:'$D(PSGST),PSGDA:$D(PSGST)

HDGP ;PRINT PICK LIST HEADER

 W:$Y @IOF W !,"WARD STOCK PHARMACY PICK LIST FOR " S Y=PSGWIN X ^DD("DD") W ?35,Y," INVENTORY #  ",PSGWIDA,?99,PSGTODAY,?120,"PAGE ",PSGPAGE

 W !,"GROUP: " D WRTGRP^PSGWPI2

 W !,?10,"ITEM",?75,"TO BE",?90,"QUANTITY",!,?73,"DISPENSED",?91,"PICKED",!

 F I=1:1:132 W "-"

 S PSGPAGE=PSGPAGE+1

 Q

END K ^TMP("PSGWDL",$J),I,PSGDA,PSGDL1,PSGDL2,PSGDL3,PSGDR,PSGPAGE,PSGTODAY,PSGST Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSGWPL1   1640     printed  Apr 09, 2024@20:43:43                                                                                                                                                                                                     Page 2

PSGWPL1   ;BHAM ISC/MPH,CML-Print AOU Inventory Pick List - CONTINUED ; 17 Jun 93 / 10:39 AM

 +1       ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94

 +2        SET PSGDL1=""

 +3        IF $PIECE(^PSI(58.19,PSGWIDA,0),"^",4)=""

               WRITE !!,"AOU INVENTORY GROUP MISSING"

               GOTO END

 +4        DO HDGP

PSGDL1     SET PSGDL1=$ORDER(^TMP("PSGWDL",$JOB,PSGDL1))

           if PSGDL1=""

               GOTO END

           WRITE !,?17,PSGDL1

           SET PSGDL2=""

           SET EXP=$ORDER(^PSI(58.17,"B",PSGDL1,0))

           if EXP>0

               WRITE " ",$PIECE(^PSI(58.17,EXP,0),"^",3)

PSGDL2     SET PSGDL2=$ORDER(^TMP("PSGWDL",$JOB,PSGDL1,PSGDL2))

           if PSGDL2=""

               GOTO PSGDL1

           SET PSGDL3=""

PSGDL3     SET PSGDL3=$ORDER(^TMP("PSGWDL",$JOB,PSGDL1,PSGDL2,PSGDL3))

           if PSGDL3=""

               GOTO PSGDL2

           SET PSGDR=""

PSGDR      SET PSGDR=$ORDER(^TMP("PSGWDL",$JOB,PSGDL1,PSGDL2,PSGDL3,PSGDR))

           if PSGDR=""

               GOTO PSGDL3

           SET PSGDA=""

 +1        if $Y+5>IOSL

               DO HDGP

PNT        WRITE !,?1,PSGDL2,$SELECT(PSGDL3'=" ":","_PSGDL3,PSGDL3="":" ",1:""),?10,PSGDR

PSGDA      IF $DATA(PSGST)

               SET PSGDA=$ORDER(^TMP("PSGWDL",$JOB,PSGDL1,PSGDL2,PSGDL3,PSGDR,PSGDA))

               if PSGDA=""

                   WRITE ?52,"-------------------------",!?52,"TOTAL ",?73,$JUSTIFY(+^TMP("PSGWDL",$JOB,PSGDL1,PSGDL2,PSGDL3,PSGDR),3),?90,"______",!

               if PSGDA=""

                   GOTO PSGDR

 +1        IF $DATA(PSGST)

               WRITE ?52,$PIECE(^PSI(58.1,PSGDA,0),"^",1),?73,$JUSTIFY(+^TMP("PSGWDL",$JOB,PSGDL1,PSGDL2,PSGDL3,PSGDR,PSGDA),3),!

 +2       IF '$TEST

               WRITE ?73,$JUSTIFY(+^TMP("PSGWDL",$JOB,PSGDL1,PSGDL2,PSGDL3,PSGDR),3),?90,"______"

 +3        if '$DATA(PSGST)

               GOTO PSGDR

           if $DATA(PSGST)

               GOTO PSGDA

HDGP      ;PRINT PICK LIST HEADER

 +1        if $Y

               WRITE @IOF

           WRITE !,"WARD STOCK PHARMACY PICK LIST FOR "

           SET Y=PSGWIN

           XECUTE ^DD("DD")

           WRITE ?35,Y," INVENTORY #  ",PSGWIDA,?99,PSGTODAY,?120,"PAGE ",PSGPAGE

 +2        WRITE !,"GROUP: "

           DO WRTGRP^PSGWPI2

 +3        WRITE !,?10,"ITEM",?75,"TO BE",?90,"QUANTITY",!,?73,"DISPENSED",?91,"PICKED",!

 +4        FOR I=1:1:132

               WRITE "-"

 +5        SET PSGPAGE=PSGPAGE+1

 +6        QUIT 

END        KILL ^TMP("PSGWDL",$JOB),I,PSGDA,PSGDL1,PSGDL2,PSGDL3,PSGDR,PSGPAGE,PSGTODAY,PSGST

           QUIT