PSGWADP ;BHAM ISC/PTD,CML-Print Data for AMIS Stats ; 06 Aug 93 / 2:20 PM
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
D NOW^%DTC S PSGWDT=$P(%,".")
W !!!,"This report shows data stored for AR/WS AMIS statistics.",!,"Use Enter/Edit AMIS Data (Single Drug) to make corrections.",!!,"Right margin for this report is 132 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!" K %,PSGWDT,%I,%H Q
DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G END^PSGWADP1
I $D(IO("Q")) K IO("Q") S PSGWIO=ION,ZTIO="" K ZTSAVE,ZTDTH,ZTSK S ZTRTN="ENQ^PSGWADP",ZTDESC="Compile Data for AMIS Stats",ZTSAVE("PSGWIO")="",ZTSAVE("PSGWDT")=""
I D ^%ZTLOAD,HOME^%ZIS K ZTSK G END^PSGWADP1
U IO
;
ENQ ;ENTRY POINT WHEN QUEUED
AOU K ^TMP("PSGWADP",$J) F PSGWAOU=0:0 S PSGWAOU=$O(^PSI(58.1,PSGWAOU)) G:('PSGWAOU)&($D(ZTQUEUED)) PRTQUE G:'PSGWAOU PRINT^PSGWADP1 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("PSGWADP",$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 Q
I $O(^PSDRUG(PSGWDR,0)) S PSGWNM=$S($P(^PSDRUG(PSGWDR,0),"^")'="":$P(^(0),"^"),1:"ZZNAME MISSING")
I $D(^PSDRUG(PSGWDR,660)) S LOC1=^(660)
I $D(^PSDRUG(PSGWDR,"PSG")) S LOC2=^("PSG")
I $D(LOC1),$D(LOC2) D ODUNIT S ^TMP("PSGWADP",$J,K,PSGWNM)=$P(LOC1,"^",2)_"^"_$P(LOC1,"^",3)_"^"_$P(LOC1,"^",5)_"^"_$P(LOC1,"^",6)_"^"_$P(LOC2,"^",2)_"^"_$P(LOC2,"^",3)
I $D(LOC1),'$D(LOC2) D ODUNIT S ^TMP("PSGWADP",$J,K,PSGWNM)=$P(LOC1,"^",2)_"^"_$P(LOC1,"^",3)_"^"_$P(LOC1,"^",5)_"^"_$P(LOC1,"^",6)_"^^"
I '$D(LOC1),$D(LOC2) S ^TMP("PSGWADP",$J,K,PSGWNM)="^^^^"_$P(LOC2,"^",2)_"^"_$P(LOC2,"^",3)
I '$D(LOC1),'$D(LOC2) S ^TMP("PSGWADP",$J,K,PSGWNM)="^^^^^"
K LOC1,LOC2
Q
;
ODUNIT S OUPTR=$P(LOC1,"^",2) I OUPTR'="" S OUNIT=$S($D(^DIC(51.5,OUPTR,0)):$P(^DIC(51.5,OUPTR,0),"^"),1:""),$P(LOC1,"^",2)=OUNIT
Q
;
PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
K ZTSAVE,ZTIO S ZTIO=PSGWIO,ZTRTN="PRINT^PSGWADP1",ZTDESC="Print Data for AMIS Stats",ZTDTH=$H,ZTSAVE("^TMP(""PSGWADP"",$J,")=""
D ^%ZTLOAD K ^TMP("PSGWADP",$J) G END^PSGWADP1
;
PSGWADP ;BHAM ISC/PTD,CML-Print Data for AMIS Stats ; 06 Aug 93 / 2:20 PM
+1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
+2 DO NOW^%DTC
SET PSGWDT=$PIECE(%,".")
+3 WRITE !!!,"This report shows data stored for AR/WS AMIS statistics.",!,"Use Enter/Edit AMIS Data (Single Drug) to make corrections.",!!,"Right margin for this report is 132 columns.",!,"You may queue the report to print at a later time.",!!
+4 IF '$ORDER(^PSI(58.1,0))
WRITE !,"You MUST create AOUs before running this report!"
KILL %,PSGWDT,%I,%H
QUIT
DEV KILL %ZIS,IOP
SET %ZIS="QM"
SET %ZIS("B")=""
DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"
GOTO END^PSGWADP1
+1 IF $DATA(IO("Q"))
KILL IO("Q")
SET PSGWIO=ION
SET ZTIO=""
KILL ZTSAVE,ZTDTH,ZTSK
SET ZTRTN="ENQ^PSGWADP"
SET ZTDESC="Compile Data for AMIS Stats"
SET ZTSAVE("PSGWIO")=""
SET ZTSAVE("PSGWDT")=""
+2 IF $TEST
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
GOTO END^PSGWADP1
+3 USE IO
+4 ;
ENQ ;ENTRY POINT WHEN QUEUED
AOU KILL ^TMP("PSGWADP",$JOB)
FOR PSGWAOU=0:0
SET PSGWAOU=$ORDER(^PSI(58.1,PSGWAOU))
IF ('PSGWAOU)&($DATA(ZTQUEUED))
GOTO PRTQUE
IF 'PSGWAOU
GOTO PRINT^PSGWADP1
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("PSGWADP",$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
QUIT
+1 IF $ORDER(^PSDRUG(PSGWDR,0))
SET PSGWNM=$SELECT($PIECE(^PSDRUG(PSGWDR,0),"^")'="":$PIECE(^(0),"^"),1:"ZZNAME MISSING")
+2 IF $DATA(^PSDRUG(PSGWDR,660))
SET LOC1=^(660)
+3 IF $DATA(^PSDRUG(PSGWDR,"PSG"))
SET LOC2=^("PSG")
+4 IF $DATA(LOC1)
IF $DATA(LOC2)
DO ODUNIT
SET ^TMP("PSGWADP",$JOB,K,PSGWNM)=$PIECE(LOC1,"^",2)_"^"_$PIECE(LOC1,"^",3)_"^"_$PIECE(LOC1,"^",5)_"^"_$PIECE(LOC1,"^",6)_"^"_$PIECE(LOC2,"^",2)_"^"_$PIECE(LOC2,"^",3)
+5 IF $DATA(LOC1)
IF '$DATA(LOC2)
DO ODUNIT
SET ^TMP("PSGWADP",$JOB,K,PSGWNM)=$PIECE(LOC1,"^",2)_"^"_$PIECE(LOC1,"^",3)_"^"_$PIECE(LOC1,"^",5)_"^"_$PIECE(LOC1,"^",6)_"^^"
+6 IF '$DATA(LOC1)
IF $DATA(LOC2)
SET ^TMP("PSGWADP",$JOB,K,PSGWNM)="^^^^"_$PIECE(LOC2,"^",2)_"^"_$PIECE(LOC2,"^",3)
+7 IF '$DATA(LOC1)
IF '$DATA(LOC2)
SET ^TMP("PSGWADP",$JOB,K,PSGWNM)="^^^^^"
+8 KILL LOC1,LOC2
+9 QUIT
+10 ;
ODUNIT SET OUPTR=$PIECE(LOC1,"^",2)
IF OUPTR'=""
SET OUNIT=$SELECT($DATA(^DIC(51.5,OUPTR,0)):$PIECE(^DIC(51.5,OUPTR,0),"^"),1:"")
SET $PIECE(LOC1,"^",2)=OUNIT
+1 QUIT
+2 ;
PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
+1 KILL ZTSAVE,ZTIO
SET ZTIO=PSGWIO
SET ZTRTN="PRINT^PSGWADP1"
SET ZTDESC="Print Data for AMIS Stats"
SET ZTDTH=$HOROLOG
SET ZTSAVE("^TMP(""PSGWADP"",$J,")=""
+2 DO ^%ZTLOAD
KILL ^TMP("PSGWADP",$JOB)
GOTO END^PSGWADP1
+3 ;
