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