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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWPAW 1916 printed Apr 09, 2024@20:44:52 Page 2
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 ;
