PSGWTOT2 ;BHAM ISC/PTD,CML-Print Usage Report for Single Drug for One or ALL AOUs ; 23 Mar 93 / 1:03 PM
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
ENQ ;ENTRY POINT WHEN QUEUED.
K ^TMP("PSGWUSE",$J)
AOULP I AOUFL=1 S AOU=$O(^PSI(58.1,AOU)) G:('AOU)&($D(ZTQUEUED)) PRTQUE G:'AOU PRINT
S DRGDA=0
DRG S DRGDA=$O(^PSI(58.1,AOU,1,"B",DRGNM,DRGDA)) G:(AOUFL=0)&('DRGDA)&($D(ZTQUEUED)) PRTQUE G:(AOUFL=0)&('DRGDA) PRINT G:(AOUFL=1)&('DRGDA) AOULP
;
AR ;INVENTORIES
S INVDA=0
INVLP S INVDA=$O(^PSI(58.1,AOU,1,DRGDA,1,INVDA)) G:'INVDA OD S INVDT=$S($D(^PSI(58.19,INVDA,0)):$P(^(0),"^"),1:"")
I 'INVDT,'$D(^PSI(58.19,INVDA,0)) S DIE="^PSI(58.1,AOU,1,DRGDA,1,",DA=INVDA,DA(1)=DRGDA,DA(2)=AOU,DR=".01///@" D ^DIE K DIE G INVLP
I ($P(INVDT,".")'<BDT)&($P(INVDT,".")'>EDT) S:$P(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5)'="" ^TMP("PSGWUSE",$J,AOU,"AR",INVDT)=$P(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5)
G INVLP
;
OD ;ON DEMANDS
S ODA=0
ODLP S ODA=$O(^PSI(58.1,AOU,1,DRGDA,5,ODA)) G:'ODA RET S ODT=$P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^")
I ($P(ODT,".")'<BDT)&($P(ODT,".")'>EDT) S:$P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2)'="" ^TMP("PSGWUSE",$J,AOU,"OD",ODT)=$P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2)
G ODLP
;
RET ;RETURNS
S RETDT=0
RETLP S RETDT=$O(^PSI(58.1,AOU,1,DRGDA,3,RETDT)) G:'RETDT DRG
I (RETDT'<BDT)&(RETDT'>EDT) S:$P(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2)'="" ^TMP("PSGWUSE",$J,AOU,"RT",RETDT)=$P(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2)
G RETLP
;
PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
K ZTSAVE,ZTIO S ZTIO=PSGWIO,ZTRTN="PRINT^PSGWTOT2",ZTDESC="Print Usage Report",ZTDTH=$H,ZTSAVE("^TMP(""PSGWUSE"",$J,")="" F G="BDT","EDT","AOU","AOUFL","ITNAM","ITMFL","DRGNM" S:$D(@G) ZTSAVE(G)=""
D ^%ZTLOAD G END
;
PRINT ;PRINT USAGE REPORT FOR SINGLE DRUG BY AOU
S (AOU,GRTOT)=0,PGCT=1,QFLG="" I '$O(^TMP("PSGWUSE",$J,AOU)) D HDR W !!?10,"NO USAGE FOR ",ITNAM," FOR SELECTED DATES." G DONE
D HDR
AOU S (DRGQD,ARQD,ODQD,RTQD,QD,TYP)=0 S AOU=$O(^TMP("PSGWUSE",$J,AOU)) D:('AOU)&(AOUFL=1) GRTOT G:QFLG END G:'AOU DONE D SUB G:QFLG END
TYP S TYP=$O(^TMP("PSGWUSE",$J,AOU,TYP)),INVDT=0 D:TYP="" TOTAL G:QFLG END G:TYP="" AOU D:$Y+5>IOSL PRTCHK G:QFLG END W:TYP="AR" !?10,"AUTO REPLENISHMENT" W:TYP="OD" !?10,"ON DEMAND" W:TYP="RT" !?10,"RETURNS"
DT S INVDT=$O(^TMP("PSGWUSE",$J,AOU,TYP,INVDT)) G:'INVDT SUBTOT S QD=$P(^TMP("PSGWUSE",$J,AOU,TYP,INVDT),"^")
I TYP="AR" S ARQD=ARQD+QD,DRGQD=DRGQD+QD
I TYP="OD" S ODQD=ODQD+QD,DRGQD=DRGQD+QD
I TYP="RT" S RTQD=RTQD+QD,DRGQD=DRGQD-QD
D:$Y+5>IOSL PRTCHK G:QFLG END D WRTLN G DT
;
DONE I $E(IOST)'="C" W @IOF
I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
END K ^TMP("PSGWUSE",$J),AOU,AOUFL,ARQD,BDT,DRGDA,ANS,QFLG,DRGNM,DRGQD,EDT,INVDA,INVDT,ITMFL,ITNAM,J,GRTOT,ODA,ODT,ODQD,PGCT,QD,RETDT,RTQD,TYP,PSGWIO,PSGWION,ZTSK,ZTIO,%,%H,%I,DA,G,X,Y,DA,DR
D ^%ZISC
S:$D(ZTQUEUED) ZTREQ="@" Q
;
HDR ;
W:$Y @IOF W !,"USAGE REPORT FROM " S Y=BDT X ^DD("DD") W Y," TO " S Y=EDT X ^DD("DD") W Y,?70,"PAGE ",PGCT S PGCT=PGCT+1
W !?5,"AREA OF USE",?55,"DATE: ",$$PSGWDT^PSGWUTL1,!,"ITEM",?15,"INVENTORY DATE",?35,"DISPENSE QUANTITY",! F J=1:1:80 W "-"
Q
SUB ;
I $Y+5>IOSL D PRTCHK I QFLG Q
W !!?5,"==> ",$P(^PSI(58.1,AOU,0),"^"),!,ITNAM,!!
Q
;
WRTLN S Y=INVDT X ^DD("DD") W !?15,$P(Y,"@")," ",$P(Y,"@",2),?43,$J(QD,4) Q
SUBTOT ;
I $Y+5>IOSL D PRTCHK I QFLG Q
W !?43,"-----" W:TYP="AR" !?12,"SUBTOTAL AUTO REPL.",?40,"+",?43,$J(ARQD,4),! W:TYP="OD" !?12,"SUBTOTAL ON DEMAND",?40,"+",?43,$J(ODQD,4),! W:TYP="RT" !?12,"SUBTOTAL RETURNS",?40,"-",?43,$J(RTQD,4),!
G TYP
;
TOTAL W !?42,"=======",!,"TOTAL DISPENSED",?43,$J(DRGQD,4) S GRTOT=GRTOT+DRGQD
Q
GRTOT ;
I $Y+5>IOSL D PRTCHK I QFLG Q
W !!?38 F J=1:1:15 W "="
W !,"TOTAL USAGE FOR ALL AREAS IS:",?43,$J(GRTOT,4)
Q
PRTCHK ;
I $E(IOST)="C" W !!,"Press <RETURN> to Continue or ""^"" to Exit: " R ANS:DTIME S:'$T ANS="^" D:ANS?1."?" HELP^PSGWUTL1 I ANS="^" S QFLG=1 Q
D HDR Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWTOT2 3951 printed Nov 22, 2024@16:50:25 Page 2
PSGWTOT2 ;BHAM ISC/PTD,CML-Print Usage Report for Single Drug for One or ALL AOUs ; 23 Mar 93 / 1:03 PM
+1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
ENQ ;ENTRY POINT WHEN QUEUED.
+1 KILL ^TMP("PSGWUSE",$JOB)
AOULP IF AOUFL=1
SET AOU=$ORDER(^PSI(58.1,AOU))
if ('AOU)&($DATA(ZTQUEUED))
GOTO PRTQUE
if 'AOU
GOTO PRINT
+1 SET DRGDA=0
DRG SET DRGDA=$ORDER(^PSI(58.1,AOU,1,"B",DRGNM,DRGDA))
if (AOUFL=0)&('DRGDA)&($DATA(ZTQUEUED))
GOTO PRTQUE
if (AOUFL=0)&('DRGDA)
GOTO PRINT
if (AOUFL=1)&('DRGDA)
GOTO AOULP
+1 ;
AR ;INVENTORIES
+1 SET INVDA=0
INVLP SET INVDA=$ORDER(^PSI(58.1,AOU,1,DRGDA,1,INVDA))
if 'INVDA
GOTO OD
SET INVDT=$SELECT($DATA(^PSI(58.19,INVDA,0)):$PIECE(^(0),"^"),1:"")
+1 IF 'INVDT
IF '$DATA(^PSI(58.19,INVDA,0))
SET DIE="^PSI(58.1,AOU,1,DRGDA,1,"
SET DA=INVDA
SET DA(1)=DRGDA
SET DA(2)=AOU
SET DR=".01///@"
DO ^DIE
KILL DIE
GOTO INVLP
+2 IF ($PIECE(INVDT,".")'<BDT)&($PIECE(INVDT,".")'>EDT)
if $PIECE(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5)'=""
SET ^TMP("PSGWUSE",$JOB,AOU,"AR",INVDT)=$PIECE(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5)
+3 GOTO INVLP
+4 ;
OD ;ON DEMANDS
+1 SET ODA=0
ODLP SET ODA=$ORDER(^PSI(58.1,AOU,1,DRGDA,5,ODA))
if 'ODA
GOTO RET
SET ODT=$PIECE(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^")
+1 IF ($PIECE(ODT,".")'<BDT)&($PIECE(ODT,".")'>EDT)
if $PIECE(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2)'=""
SET ^TMP("PSGWUSE",$JOB,AOU,"OD",ODT)=$PIECE(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2)
+2 GOTO ODLP
+3 ;
RET ;RETURNS
+1 SET RETDT=0
RETLP SET RETDT=$ORDER(^PSI(58.1,AOU,1,DRGDA,3,RETDT))
if 'RETDT
GOTO DRG
+1 IF (RETDT'<BDT)&(RETDT'>EDT)
if $PIECE(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2)'=""
SET ^TMP("PSGWUSE",$JOB,AOU,"RT",RETDT)=$PIECE(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2)
+2 GOTO RETLP
+3 ;
PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
+1 KILL ZTSAVE,ZTIO
SET ZTIO=PSGWIO
SET ZTRTN="PRINT^PSGWTOT2"
SET ZTDESC="Print Usage Report"
SET ZTDTH=$HOROLOG
SET ZTSAVE("^TMP(""PSGWUSE"",$J,")=""
FOR G="BDT","EDT","AOU","AOUFL","ITNAM","ITMFL","DRGNM"
if $DATA(@G)
SET ZTSAVE(G)=""
+2 DO ^%ZTLOAD
GOTO END
+3 ;
PRINT ;PRINT USAGE REPORT FOR SINGLE DRUG BY AOU
+1 SET (AOU,GRTOT)=0
SET PGCT=1
SET QFLG=""
IF '$ORDER(^TMP("PSGWUSE",$JOB,AOU))
DO HDR
WRITE !!?10,"NO USAGE FOR ",ITNAM," FOR SELECTED DATES."
GOTO DONE
+2 DO HDR
AOU SET (DRGQD,ARQD,ODQD,RTQD,QD,TYP)=0
SET AOU=$ORDER(^TMP("PSGWUSE",$JOB,AOU))
if ('AOU)&(AOUFL=1)
DO GRTOT
if QFLG
GOTO END
if 'AOU
GOTO DONE
DO SUB
if QFLG
GOTO END
TYP SET TYP=$ORDER(^TMP("PSGWUSE",$JOB,AOU,TYP))
SET INVDT=0
if TYP=""
DO TOTAL
if QFLG
GOTO END
if TYP=""
GOTO AOU
if $Y+5>IOSL
DO PRTCHK
if QFLG
GOTO END
if TYP="AR"
WRITE !?10,"AUTO REPLENISHMENT"
if TYP="OD"
WRITE !?10,"ON DEMAND"
if TYP="RT"
WRITE !?10,"RETURNS"
DT SET INVDT=$ORDER(^TMP("PSGWUSE",$JOB,AOU,TYP,INVDT))
if 'INVDT
GOTO SUBTOT
SET QD=$PIECE(^TMP("PSGWUSE",$JOB,AOU,TYP,INVDT),"^")
+1 IF TYP="AR"
SET ARQD=ARQD+QD
SET DRGQD=DRGQD+QD
+2 IF TYP="OD"
SET ODQD=ODQD+QD
SET DRGQD=DRGQD+QD
+3 IF TYP="RT"
SET RTQD=RTQD+QD
SET DRGQD=DRGQD-QD
+4 if $Y+5>IOSL
DO PRTCHK
if QFLG
GOTO END
DO WRTLN
GOTO DT
+5 ;
DONE IF $EXTRACT(IOST)'="C"
WRITE @IOF
+1 IF $EXTRACT(IOST)="C"
if 'QFLG
DO SS^PSGWUTL1
END KILL ^TMP("PSGWUSE",$JOB),AOU,AOUFL,ARQD,BDT,DRGDA,ANS,QFLG,DRGNM,DRGQD,EDT,INVDA,INVDT,ITMFL,ITNAM,J,GRTOT,ODA,ODT,ODQD,PGCT,QD,RETDT,RTQD,TYP,PSGWIO,PSGWION,ZTSK,ZTIO,%,%H,%I,DA,G,X,Y,DA,DR
+1 DO ^%ZISC
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 ;
HDR ;
+1 if $Y
WRITE @IOF
WRITE !,"USAGE REPORT FROM "
SET Y=BDT
XECUTE ^DD("DD")
WRITE Y," TO "
SET Y=EDT
XECUTE ^DD("DD")
WRITE Y,?70,"PAGE ",PGCT
SET PGCT=PGCT+1
+2 WRITE !?5,"AREA OF USE",?55,"DATE: ",$$PSGWDT^PSGWUTL1,!,"ITEM",?15,"INVENTORY DATE",?35,"DISPENSE QUANTITY",!
FOR J=1:1:80
WRITE "-"
+3 QUIT
SUB ;
+1 IF $Y+5>IOSL
DO PRTCHK
IF QFLG
QUIT
+2 WRITE !!?5,"==> ",$PIECE(^PSI(58.1,AOU,0),"^"),!,ITNAM,!!
+3 QUIT
+4 ;
WRTLN SET Y=INVDT
XECUTE ^DD("DD")
WRITE !?15,$PIECE(Y,"@")," ",$PIECE(Y,"@",2),?43,$JUSTIFY(QD,4)
QUIT
SUBTOT ;
+1 IF $Y+5>IOSL
DO PRTCHK
IF QFLG
QUIT
+2 WRITE !?43,"-----"
if TYP="AR"
WRITE !?12,"SUBTOTAL AUTO REPL.",?40,"+",?43,$JUSTIFY(ARQD,4),!
if TYP="OD"
WRITE !?12,"SUBTOTAL ON DEMAND",?40,"+",?43,$JUSTIFY(ODQD,4),!
if TYP="RT"
WRITE !?12,"SUBTOTAL RETURNS",?40,"-",?43,$JUSTIFY(RTQD,4),!
+3 GOTO TYP
+4 ;
TOTAL WRITE !?42,"=======",!,"TOTAL DISPENSED",?43,$JUSTIFY(DRGQD,4)
SET GRTOT=GRTOT+DRGQD
+1 QUIT
GRTOT ;
+1 IF $Y+5>IOSL
DO PRTCHK
IF QFLG
QUIT
+2 WRITE !!?38
FOR J=1:1:15
WRITE "="
+3 WRITE !,"TOTAL USAGE FOR ALL AREAS IS:",?43,$JUSTIFY(GRTOT,4)
+4 QUIT
PRTCHK ;
+1 IF $EXTRACT(IOST)="C"
WRITE !!,"Press <RETURN> to Continue or ""^"" to Exit: "
READ ANS:DTIME
if '$TEST
SET ANS="^"
if ANS?1."?"
DO HELP^PSGWUTL1
IF ANS="^"
SET QFLG=1
QUIT
+2 DO HDR
QUIT
