- 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 Mar 13, 2025@20:44:52 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
