- PSGWTOT1 ;BHAM ISC/PTD,CML-Print Usage Report for All Drugs for a single AOU or ALL AOUs ; 23 Mar 93 / 1:02 PM
- ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- ENQ ;ENTRY POINT WHEN QUEUED
- ;CREATE ARRAY OF INVENTORY NUMBERS THAT FALL IN DATE RANGE.
- K ^TMP("PSGWUSE",$J) S INVN=0
- F J=0:0 S INVN=$O(^PSI(58.19,INVN)) Q:'INVN S INVDT=$P($P(^PSI(58.19,INVN,0),"^"),".") I (INVDT'<BDT)&(INVDT'>EDT) S ^TMP("PSGWUSE",$J,"INV",INVN)=""
- AOU I AOUFL=1 S AOU=$O(^PSI(58.1,AOU)) G:('AOU)&($D(ZTQUEUED)) PRTQUE G:'AOU PRINT
- DRUG ;LOOP THROUGH DRUGS FOR AOU
- S DRGDA=0
- DRGLP S DRGDA=$O(^PSI(58.1,AOU,1,DRGDA)) G:(AOUFL=0)&('DRGDA)&($D(ZTQUEUED)) PRTQUE G:(AOUFL=0)&('DRGDA) PRINT G:(AOUFL=1)&('DRGDA) AOU S DRGNM=$P(^PSI(58.1,AOU,1,DRGDA,0),"^")
- I '$O(^PSDRUG(DRGNM,0)) S DIK="^PSI(58.1,"_AOU_",1,",DA=DRGDA,DA(1)=AOU D ^DIK K DIK,DA G DRGLP
- S DRGNAME=$P(^PSDRUG(DRGNM,0),"^")
- ;
- AR ;AUTOMATIC REPLENISHMENT INVENTORIES
- S (DRGQD,INVDA,ARQD,ODQD,RTQD)=0
- INVLP S INVDA=$O(^PSI(58.1,AOU,1,DRGDA,1,INVDA)) G:'INVDA OD
- I $D(^TMP("PSGWUSE",$J,"INV",INVDA)) S QD=$P(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5),ARQD=ARQD+QD,DRGQD=DRGQD+QD G INVLP
- E G INVLP
- ;
- OD ;ON DEMAND REQUESTS
- S ODA=0
- ODLP S ODA=$O(^PSI(58.1,AOU,1,DRGDA,5,ODA)) G:'ODA RET S ODT=$P($P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^"),".")
- I (ODT'<BDT)&(ODT'>EDT) S QD=$P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2),ODQD=ODQD+QD,DRGQD=DRGQD+QD G ODLP
- E G ODLP
- ;
- RET ;RETURNS
- S RETDT=0
- RETLP S RETDT=$O(^PSI(58.1,AOU,1,DRGDA,3,RETDT)) G:'RETDT SETGL
- I (RETDT'<BDT)&(RETDT'>EDT) S QD=$P(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2),RTQD=RTQD+QD,DRGQD=DRGQD-QD G RETLP
- E G RETLP
- ;
- SETGL S:DRGQD>0 ^TMP("PSGWUSE",$J,AOU,DRGNAME)=DRGQD_"^"_ARQD_"^"_ODQD_"^"_RTQD G DRGLP
- ;
- PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
- K ZTSAVE,ZTIO S ZTIO=PSGWIO,ZTRTN="PRINT^PSGWTOT1",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 ALL DRUGS BY AOU
- S AOU=0,PGCT=1,QFLG="" I '$O(^TMP("PSGWUSE",$J,AOU)) D HDR W !!,"NO USAGE FOR SELECTED DATE RANGE." G DONE
- AOULP S AOU=$O(^TMP("PSGWUSE",$J,AOU)) G:'AOU DONE I PGCT>1 D PRTCHK G:QFLG END
- D:PGCT<2 HDR W !?5,"==> ",$P(^PSI(58.1,AOU,0),"^") S DRG=0 I $D(^PSI(58.1,AOU,"I")),^("I"),^("I")'>DT W " *** INACTIVE ***"
- DRLP S DRG=$O(^TMP("PSGWUSE",$J,AOU,DRG)) G:DRG="" AOULP S LOC=^TMP("PSGWUSE",$J,AOU,DRG) D:$Y+5>IOSL PRTCHK G:QFLG END W !,DRG,?42,$J($P(LOC,"^"),4),?51,$J($P(LOC,"^",2),4),?62,$J($P(LOC,"^",3),4),?72,$J($P(LOC,"^",4),4) G DRLP
- ;
- DONE I $E(IOST)'="C" W @IOF
- I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
- END K ^TMP("PSGWUSE",$J),AOU,AOUFL,ARQD,BDT,DRG,DRGDA,DRGNAME,DRGNM,DRGQD,EDT,INVDA,INVDT,INVN,ITMFL,ITNAM,J,LOC,ODA,ODQD,ODT,PGCT,QD,RETDT,RTQD,PSGWIO,ZTSK,ZTIO,%,%H,%I,G,DA,X,Y,ANS,QFLG
- D ^%ZISC
- S:$D(ZTQUEUED) ZTREQ="@" Q
- ;
- HDR ;PRINT REPORT HEADER
- 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,!!?5,"AREA OF USE",?55,"DATE: ",$$PSGWDT^PSGWUTL1
- W !,"ITEM",?35,"DISPENSE QUANTITY",!?42,"TOTAL",?49,"AUTO REPL",?60,"ON DEMAND",?72,"RETURNS" S PGCT=PGCT+1
- W ! F J=1:1:80 W "-"
- 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
- PSGWTOT1 ;BHAM ISC/PTD,CML-Print Usage Report for All Drugs for a single AOU or ALL AOUs ; 23 Mar 93 / 1:02 PM
- +1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- ENQ ;ENTRY POINT WHEN QUEUED
- +1 ;CREATE ARRAY OF INVENTORY NUMBERS THAT FALL IN DATE RANGE.
- +2 KILL ^TMP("PSGWUSE",$JOB)
- SET INVN=0
- +3 FOR J=0:0
- SET INVN=$ORDER(^PSI(58.19,INVN))
- IF 'INVN
- QUIT
- SET INVDT=$PIECE($PIECE(^PSI(58.19,INVN,0),"^"),".")
- IF (INVDT'<BDT)&(INVDT'>EDT)
- SET ^TMP("PSGWUSE",$JOB,"INV",INVN)=""
- AOU IF AOUFL=1
- SET AOU=$ORDER(^PSI(58.1,AOU))
- IF ('AOU)&($DATA(ZTQUEUED))
- GOTO PRTQUE
- IF 'AOU
- GOTO PRINT
- DRUG ;LOOP THROUGH DRUGS FOR AOU
- +1 SET DRGDA=0
- DRGLP SET DRGDA=$ORDER(^PSI(58.1,AOU,1,DRGDA))
- IF (AOUFL=0)&('DRGDA)&($DATA(ZTQUEUED))
- GOTO PRTQUE
- IF (AOUFL=0)&('DRGDA)
- GOTO PRINT
- IF (AOUFL=1)&('DRGDA)
- GOTO AOU
- SET DRGNM=$PIECE(^PSI(58.1,AOU,1,DRGDA,0),"^")
- +1 IF '$ORDER(^PSDRUG(DRGNM,0))
- SET DIK="^PSI(58.1,"_AOU_",1,"
- SET DA=DRGDA
- SET DA(1)=AOU
- DO ^DIK
- KILL DIK,DA
- GOTO DRGLP
- +2 SET DRGNAME=$PIECE(^PSDRUG(DRGNM,0),"^")
- +3 ;
- AR ;AUTOMATIC REPLENISHMENT INVENTORIES
- +1 SET (DRGQD,INVDA,ARQD,ODQD,RTQD)=0
- INVLP SET INVDA=$ORDER(^PSI(58.1,AOU,1,DRGDA,1,INVDA))
- IF 'INVDA
- GOTO OD
- +1 IF $DATA(^TMP("PSGWUSE",$JOB,"INV",INVDA))
- SET QD=$PIECE(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5)
- SET ARQD=ARQD+QD
- SET DRGQD=DRGQD+QD
- GOTO INVLP
- +2 IF '$TEST
- GOTO INVLP
- +3 ;
- OD ;ON DEMAND REQUESTS
- +1 SET ODA=0
- ODLP SET ODA=$ORDER(^PSI(58.1,AOU,1,DRGDA,5,ODA))
- IF 'ODA
- GOTO RET
- SET ODT=$PIECE($PIECE(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^"),".")
- +1 IF (ODT'<BDT)&(ODT'>EDT)
- SET QD=$PIECE(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2)
- SET ODQD=ODQD+QD
- SET DRGQD=DRGQD+QD
- GOTO ODLP
- +2 IF '$TEST
- GOTO ODLP
- +3 ;
- RET ;RETURNS
- +1 SET RETDT=0
- RETLP SET RETDT=$ORDER(^PSI(58.1,AOU,1,DRGDA,3,RETDT))
- IF 'RETDT
- GOTO SETGL
- +1 IF (RETDT'<BDT)&(RETDT'>EDT)
- SET QD=$PIECE(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2)
- SET RTQD=RTQD+QD
- SET DRGQD=DRGQD-QD
- GOTO RETLP
- +2 IF '$TEST
- GOTO RETLP
- +3 ;
- SETGL IF DRGQD>0
- SET ^TMP("PSGWUSE",$JOB,AOU,DRGNAME)=DRGQD_"^"_ARQD_"^"_ODQD_"^"_RTQD
- GOTO DRGLP
- +1 ;
- PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
- +1 KILL ZTSAVE,ZTIO
- SET ZTIO=PSGWIO
- SET ZTRTN="PRINT^PSGWTOT1"
- 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 ALL DRUGS BY AOU
- +1 SET AOU=0
- SET PGCT=1
- SET QFLG=""
- IF '$ORDER(^TMP("PSGWUSE",$JOB,AOU))
- DO HDR
- WRITE !!,"NO USAGE FOR SELECTED DATE RANGE."
- GOTO DONE
- AOULP SET AOU=$ORDER(^TMP("PSGWUSE",$JOB,AOU))
- IF 'AOU
- GOTO DONE
- IF PGCT>1
- DO PRTCHK
- IF QFLG
- GOTO END
- +1 IF PGCT<2
- DO HDR
- WRITE !?5,"==> ",$PIECE(^PSI(58.1,AOU,0),"^")
- SET DRG=0
- IF $DATA(^PSI(58.1,AOU,"I"))
- IF ^("I")
- IF ^("I")'>DT
- WRITE " *** INACTIVE ***"
- DRLP SET DRG=$ORDER(^TMP("PSGWUSE",$JOB,AOU,DRG))
- IF DRG=""
- GOTO AOULP
- SET LOC=^TMP("PSGWUSE",$JOB,AOU,DRG)
- IF $Y+5>IOSL
- DO PRTCHK
- IF QFLG
- GOTO END
- WRITE !,DRG,?42,$JUSTIFY($PIECE(LOC,"^"),4),?51,$JUSTIFY($PIECE(LOC,"^",2),4),?62,$JUSTIFY($PIECE(LOC,"^",3),4),?72,$JUSTIFY($PIECE(LOC,"^",4),4)
- GOTO DRLP
- +1 ;
- 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,DRG,DRGDA,DRGNAME,DRGNM,DRGQD,EDT,INVDA,INVDT,INVN,ITMFL,ITNAM,J,LOC,ODA,ODQD,ODT,PGCT,QD,RETDT,RTQD,PSGWIO,ZTSK,ZTIO,%,%H,%I,G,DA,X,Y,ANS,QFLG
- +1 DO ^%ZISC
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +3 ;
- HDR ;PRINT REPORT HEADER
- +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,!!?5,"AREA OF USE",?55,"DATE: ",$$PSGWDT^PSGWUTL1
- +2 WRITE !,"ITEM",?35,"DISPENSE QUANTITY",!?42,"TOTAL",?49,"AUTO REPL",?60,"ON DEMAND",?72,"RETURNS"
- SET PGCT=PGCT+1
- +3 WRITE !
- FOR J=1:1:80
- WRITE "-"
- +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
