- PSGWPSI ;BHAM ISC/CML-Print Data for AR/WS Stock Items ; 19 Mar 93 / 8:34 AM
- ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- D NOW^%DTC S PSGWDT=$P(%,".")
- W !!!,"This report shows data stored for AR/WS Stock Items.",!!,"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 %,%I,%H,PSGWDT Q
- DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G QUIT^PSGWPSI1
- I $D(IO("Q")) K IO("Q") S PSGWIO=ION,ZTIO="" K ZTSAVE,ZTDTH,ZTSK S ZTRTN="ENQ^PSGWPSI",ZTDESC="Compile Data for AR/WS Stock Items",ZTSAVE("PSGWIO")="",ZTSAVE("PSGWDT")=""
- I D ^%ZTLOAD,HOME^%ZIS K ZTSK G QUIT^PSGWPSI1
- U IO
- ;
- ENQ ;ENTRY POINT WHEN QUEUED
- AOU K ^TMP("PSGWPSI",$J) F AOU=0:0 S AOU=$O(^PSI(58.1,AOU)) G:('AOU)&($D(ZTQUEUED)) PRTQUE G:'AOU PRINT^PSGWPSI1 D XREF
- ;
- XREF F DRGDA=0:0 S DRGDA=$O(^PSI(58.1,AOU,1,"B",DRGDA)) Q:'DRGDA F ITMDA=0:0 S ITMDA=$O(^PSI(58.1,AOU,1,"B",DRGDA,ITMDA)) Q:'ITMDA D BUILD
- Q
- BUILD ;BUILD DATA ELEMENTS
- Q:'$D(^PSI(58.1,AOU,1,ITMDA,0)) S NODE=^(0) I +$P(NODE,"^",3),+$P(NODE,"^",3)'>DT Q
- I '$O(^PSDRUG(DRGDA,0)) S DIK="^PSI(58.1,"_AOU_",1,",DA=ITMDA,DA(1)=AOU D ^DIK K DIK Q
- I $O(^PSDRUG(DRGDA,0)) S ITMNM=$S($P(^PSDRUG(DRGDA,0),"^")]"":$P(^(0),"^"),1:"ZZ/DRUG #"_DRGDA_" is missing NAME in the DRUG File.")
- I $P(NODE,"^",10)="Y",$P(NODE,"^",3)="" S $P(^PSI(58.1,AOU,1,ITMDA,0),"^",10)=""
- I $D(^PSI(58.1,AOU,"I")),$P(^("I"),"^"),$P(^("I"),"^")'>PSGWDT S ^TMP("PSGWPSI",$J,ITMNM,AOU)="I^"_$P(^("I"),"^") Q
- S LOC=$S($P(NODE,"^",8)]"":$P(NODE,"^",8),1:"NONE"),STKLEV=$S($P(NODE,"^",2):$P(NODE,"^",2),1:"NONE")
- S TYPE="" F LL=0:0 S LL=$O(^PSI(58.1,AOU,1,ITMDA,2,LL)) Q:'LL S TYPE=TYPE_";;"_LL
- S WARD="" F LL=0:0 S LL=$O(^PSI(58.1,AOU,1,ITMDA,4,LL)) Q:'LL S WARD=WARD_";;"_LL
- SETGL ;
- S:WARD="" WARD=";;NONE" S:TYPE="" TYPE=";;NONE" S ^TMP("PSGWPSI",$J,ITMNM,AOU)=LOC_"^"_STKLEV_"^"_WARD_"^"_TYPE Q
- Q
- ;
- PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
- K ZTSAVE,ZTIO S ZTIO=PSGWIO,ZTRTN="PRINT^PSGWPSI1",ZTDESC="Print Data for AR/WS Stock Items",ZTDTH=$H,ZTSAVE("^TMP(""PSGWPSI"",$J,")=""
- D ^%ZTLOAD K ^TMP("PSGWPSI",$J) G QUIT^PSGWPSI1
- PSGWPSI ;BHAM ISC/CML-Print Data for AR/WS Stock Items ; 19 Mar 93 / 8:34 AM
- +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 Stock Items.",!!,"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 %,%I,%H,PSGWDT
- QUIT
- DEV KILL %ZIS,IOP
- SET %ZIS="QM"
- SET %ZIS("B")=""
- DO ^%ZIS
- IF POP
- WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"
- GOTO QUIT^PSGWPSI1
- +1 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET PSGWIO=ION
- SET ZTIO=""
- KILL ZTSAVE,ZTDTH,ZTSK
- SET ZTRTN="ENQ^PSGWPSI"
- SET ZTDESC="Compile Data for AR/WS Stock Items"
- SET ZTSAVE("PSGWIO")=""
- SET ZTSAVE("PSGWDT")=""
- +2 IF $TEST
- DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL ZTSK
- GOTO QUIT^PSGWPSI1
- +3 USE IO
- +4 ;
- ENQ ;ENTRY POINT WHEN QUEUED
- AOU KILL ^TMP("PSGWPSI",$JOB)
- FOR AOU=0:0
- SET AOU=$ORDER(^PSI(58.1,AOU))
- IF ('AOU)&($DATA(ZTQUEUED))
- GOTO PRTQUE
- IF 'AOU
- GOTO PRINT^PSGWPSI1
- DO XREF
- +1 ;
- XREF FOR DRGDA=0:0
- SET DRGDA=$ORDER(^PSI(58.1,AOU,1,"B",DRGDA))
- IF 'DRGDA
- QUIT
- FOR ITMDA=0:0
- SET ITMDA=$ORDER(^PSI(58.1,AOU,1,"B",DRGDA,ITMDA))
- IF 'ITMDA
- QUIT
- DO BUILD
- +1 QUIT
- BUILD ;BUILD DATA ELEMENTS
- +1 IF '$DATA(^PSI(58.1,AOU,1,ITMDA,0))
- QUIT
- SET NODE=^(0)
- IF +$PIECE(NODE,"^",3)
- IF +$PIECE(NODE,"^",3)'>DT
- QUIT
- +2 IF '$ORDER(^PSDRUG(DRGDA,0))
- SET DIK="^PSI(58.1,"_AOU_",1,"
- SET DA=ITMDA
- SET DA(1)=AOU
- DO ^DIK
- KILL DIK
- QUIT
- +3 IF $ORDER(^PSDRUG(DRGDA,0))
- SET ITMNM=$SELECT($PIECE(^PSDRUG(DRGDA,0),"^")]"":$PIECE(^(0),"^"),1:"ZZ/DRUG #"_DRGDA_" is missing NAME in the DRUG File.")
- +4 IF $PIECE(NODE,"^",10)="Y"
- IF $PIECE(NODE,"^",3)=""
- SET $PIECE(^PSI(58.1,AOU,1,ITMDA,0),"^",10)=""
- +5 IF $DATA(^PSI(58.1,AOU,"I"))
- IF $PIECE(^("I"),"^")
- IF $PIECE(^("I"),"^")'>PSGWDT
- SET ^TMP("PSGWPSI",$JOB,ITMNM,AOU)="I^"_$PIECE(^("I"),"^")
- QUIT
- +6 SET LOC=$SELECT($PIECE(NODE,"^",8)]"":$PIECE(NODE,"^",8),1:"NONE")
- SET STKLEV=$SELECT($PIECE(NODE,"^",2):$PIECE(NODE,"^",2),1:"NONE")
- +7 SET TYPE=""
- FOR LL=0:0
- SET LL=$ORDER(^PSI(58.1,AOU,1,ITMDA,2,LL))
- IF 'LL
- QUIT
- SET TYPE=TYPE_";;"_LL
- +8 SET WARD=""
- FOR LL=0:0
- SET LL=$ORDER(^PSI(58.1,AOU,1,ITMDA,4,LL))
- IF 'LL
- QUIT
- SET WARD=WARD_";;"_LL
- SETGL ;
- +1 IF WARD=""
- SET WARD=";;NONE"
- IF TYPE=""
- SET TYPE=";;NONE"
- SET ^TMP("PSGWPSI",$JOB,ITMNM,AOU)=LOC_"^"_STKLEV_"^"_WARD_"^"_TYPE
- QUIT
- +2 QUIT
- +3 ;
- PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
- +1 KILL ZTSAVE,ZTIO
- SET ZTIO=PSGWIO
- SET ZTRTN="PRINT^PSGWPSI1"
- SET ZTDESC="Print Data for AR/WS Stock Items"
- SET ZTDTH=$HOROLOG
- SET ZTSAVE("^TMP(""PSGWPSI"",$J,")=""
- +2 DO ^%ZTLOAD
- KILL ^TMP("PSGWPSI",$JOB)
- GOTO QUIT^PSGWPSI1
