PSGWPAW.m

PSGWPAW ;BHAM ISC/PTD,CML-Print AMIS Data Worksheet for All Drugs in All AOUs ; 19 Mar 93 / 8:32 AM

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

 D NOW^%DTC S PSGWDT=X W !!!,"Right margin for this report is 80 columns.",!,"You may queue the report to print at a later time.",!!

 I '$O(^PSI(58.1,0)) W !,"You MUST create AOUs before running this report!" G END^PSGWPAW1

DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G END^PSGWPAW1

 I $D(IO("Q")) K IO("Q") S PSGWIO=ION,ZTIO="" K ZTSAVE,ZTDTH,ZTSK S ZTRTN="ENQ^PSGWPAW",ZTDESC="Compile AMIS Worksheet",ZTSAVE("PSGWIO")="",ZTSAVE("PSGWDT")=""

 I  D ^%ZTLOAD,HOME^%ZIS K ZTSK G END^PSGWPAW1

 U IO

 ;

ENQ ;ENTRY POINT WHEN QUEUED

AOU K ^TMP("PSGWPAW",$J) F PSGWAOU=0:0 S PSGWAOU=$O(^PSI(58.1,PSGWAOU)) G:('PSGWAOU)&($D(ZTQUEUED)) PRTQUE G:'PSGWAOU PRINT^PSGWPAW1 D XREF

 ;

XREF F PSGWDR=0:0 S PSGWDR=$O(^PSI(58.1,PSGWAOU,1,"B",PSGWDR)) Q:'PSGWDR  F PSGWITM=0:0 S PSGWITM=$O(^PSI(58.1,PSGWAOU,1,"B",PSGWDR,PSGWITM)) Q:'PSGWITM  D BUILD

 Q

 ;

BUILD I $P(^PSI(58.1,PSGWAOU,1,PSGWITM,0),"^",10)="Y",$P(^(0),"^",3)="" S $P(^(0),"^",10)=""

 I $P(^PSI(58.1,PSGWAOU,1,PSGWITM,0),"^",3)'="" Q:$P(^(0),"^",3)'>PSGWDT

 I '$O(^PSI(58.1,PSGWAOU,1,PSGWITM,2,0)) S K=9999 D SETGL Q

 F PSGWTY=0:0 S PSGWTY=$O(^PSI(58.1,PSGWAOU,1,PSGWITM,2,PSGWTY)) Q:'PSGWTY  S K=PSGWTY D SETGL S ^TMP("PSGWPAW",$J,"DN",PSGWNM)=""

 Q

 ;

SETGL I '$O(^PSDRUG(PSGWDR,0)) S DIK="^PSI(58.1,"_PSGWAOU_",1,",DA=PSGWITM,DA(1)=PSGWAOU D ^DIK K DIK,DA Q

 I $O(^PSDRUG(PSGWDR,0)) S PSGWNM=$S($P(^PSDRUG(PSGWDR,0),"^")'="":$P(^(0),"^"),1:"ZZNAME MISSING") S ^TMP("PSGWPAW",$J,K,PSGWNM,PSGWDR)=""

 Q

 ;

PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT

 K ZTSAVE,ZTIO S ZTIO=PSGWIO,ZTRTN="PRINT^PSGWPAW1",ZTDESC="Print AMIS Worksheet",ZTDTH=$H,ZTSAVE("^TMP(""PSGWPAW"",$J,")=""

 D ^%ZTLOAD K ^TMP("PSGWPAW",$J) G END^PSGWPAW1

 ;

PSGWPAW   ;BHAM ISC/PTD,CML-Print AMIS Data Worksheet for All Drugs in All AOUs ; 19 Mar 93 / 8:32 AM

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

 +2        DO NOW^%DTC

           SET PSGWDT=X

           WRITE !!!,"Right margin for this report is 80 columns.",!,"You may queue the report to print at a later time.",!!

 +3        IF '$ORDER(^PSI(58.1,0))

               WRITE !,"You MUST create AOUs before running this report!"

               GOTO END^PSGWPAW1

DEV        KILL %ZIS,IOP

           SET %ZIS="QM"

           SET %ZIS("B")=""

           DO ^%ZIS

           IF POP

               WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"

               GOTO END^PSGWPAW1

 +1        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET PSGWIO=ION

               SET ZTIO=""

               KILL ZTSAVE,ZTDTH,ZTSK

               SET ZTRTN="ENQ^PSGWPAW"

               SET ZTDESC="Compile AMIS Worksheet"

               SET ZTSAVE("PSGWIO")=""

               SET ZTSAVE("PSGWDT")=""

 +2       IF $TEST

               DO ^%ZTLOAD

               DO HOME^%ZIS

               KILL ZTSK

               GOTO END^PSGWPAW1

 +3        USE IO

 +4       ;

ENQ       ;ENTRY POINT WHEN QUEUED

AOU        KILL ^TMP("PSGWPAW",$JOB)

           FOR PSGWAOU=0:0

               SET PSGWAOU=$ORDER(^PSI(58.1,PSGWAOU))

               IF ('PSGWAOU)&($DATA(ZTQUEUED))

                   GOTO PRTQUE

               IF 'PSGWAOU

                   GOTO PRINT^PSGWPAW1

               DO XREF

 +1       ;

XREF       FOR PSGWDR=0:0

               SET PSGWDR=$ORDER(^PSI(58.1,PSGWAOU,1,"B",PSGWDR))

               IF 'PSGWDR

                   QUIT 

               FOR PSGWITM=0:0

                   SET PSGWITM=$ORDER(^PSI(58.1,PSGWAOU,1,"B",PSGWDR,PSGWITM))

                   IF 'PSGWITM

                       QUIT 

                   DO BUILD

 +1        QUIT 

 +2       ;

BUILD      IF $PIECE(^PSI(58.1,PSGWAOU,1,PSGWITM,0),"^",10)="Y"

               IF $PIECE(^(0),"^",3)=""

                   SET $PIECE(^(0),"^",10)=""

 +1        IF $PIECE(^PSI(58.1,PSGWAOU,1,PSGWITM,0),"^",3)'=""

               IF $PIECE(^(0),"^",3)'>PSGWDT

                   QUIT 

 +2        IF '$ORDER(^PSI(58.1,PSGWAOU,1,PSGWITM,2,0))

               SET K=9999

               DO SETGL

               QUIT 

 +3        FOR PSGWTY=0:0

               SET PSGWTY=$ORDER(^PSI(58.1,PSGWAOU,1,PSGWITM,2,PSGWTY))

               IF 'PSGWTY

                   QUIT 

               SET K=PSGWTY

               DO SETGL

               SET ^TMP("PSGWPAW",$JOB,"DN",PSGWNM)=""

 +4        QUIT 

 +5       ;

SETGL      IF '$ORDER(^PSDRUG(PSGWDR,0))

               SET DIK="^PSI(58.1,"_PSGWAOU_",1,"

               SET DA=PSGWITM

               SET DA(1)=PSGWAOU

               DO ^DIK

               KILL DIK,DA

               QUIT 

 +1        IF $ORDER(^PSDRUG(PSGWDR,0))

               SET PSGWNM=$SELECT($PIECE(^PSDRUG(PSGWDR,0),"^")'="":$PIECE(^(0),"^"),1:"ZZNAME MISSING")

               SET ^TMP("PSGWPAW",$JOB,K,PSGWNM,PSGWDR)=""

 +2        QUIT 

 +3       ;

PRTQUE    ;AFTER DATA IS COMPILED, QUEUE THE PRINT

 +1        KILL ZTSAVE,ZTIO

           SET ZTIO=PSGWIO

           SET ZTRTN="PRINT^PSGWPAW1"

           SET ZTDESC="Print AMIS Worksheet"

           SET ZTDTH=$HOROLOG

           SET ZTSAVE("^TMP(""PSGWPAW"",$J,")=""

 +2        DO ^%ZTLOAD

           KILL ^TMP("PSGWPAW",$JOB)

           GOTO END^PSGWPAW1

 +3       ;