1 | 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 | ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
---|
3 | ENQ ;ENTRY POINT WHEN QUEUED
|
---|
4 | ;CREATE ARRAY OF INVENTORY NUMBERS THAT FALL IN DATE RANGE.
|
---|
5 | K ^TMP("PSGWUSE",$J) S INVN=0
|
---|
6 | 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)=""
|
---|
7 | AOU I AOUFL=1 S AOU=$O(^PSI(58.1,AOU)) G:('AOU)&($D(ZTQUEUED)) PRTQUE G:'AOU PRINT
|
---|
8 | DRUG ;LOOP THROUGH DRUGS FOR AOU
|
---|
9 | S DRGDA=0
|
---|
10 | 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),"^")
|
---|
11 | I '$O(^PSDRUG(DRGNM,0)) S DIK="^PSI(58.1,"_AOU_",1,",DA=DRGDA,DA(1)=AOU D ^DIK K DIK,DA G DRGLP
|
---|
12 | S DRGNAME=$P(^PSDRUG(DRGNM,0),"^")
|
---|
13 | ;
|
---|
14 | AR ;AUTOMATIC REPLENISHMENT INVENTORIES
|
---|
15 | S (DRGQD,INVDA,ARQD,ODQD,RTQD)=0
|
---|
16 | INVLP S INVDA=$O(^PSI(58.1,AOU,1,DRGDA,1,INVDA)) G:'INVDA OD
|
---|
17 | 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
|
---|
18 | E G INVLP
|
---|
19 | ;
|
---|
20 | OD ;ON DEMAND REQUESTS
|
---|
21 | S ODA=0
|
---|
22 | 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),"^"),".")
|
---|
23 | 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
|
---|
24 | E G ODLP
|
---|
25 | ;
|
---|
26 | RET ;RETURNS
|
---|
27 | S RETDT=0
|
---|
28 | RETLP S RETDT=$O(^PSI(58.1,AOU,1,DRGDA,3,RETDT)) G:'RETDT SETGL
|
---|
29 | 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
|
---|
30 | E G RETLP
|
---|
31 | ;
|
---|
32 | SETGL S:DRGQD>0 ^TMP("PSGWUSE",$J,AOU,DRGNAME)=DRGQD_"^"_ARQD_"^"_ODQD_"^"_RTQD G DRGLP
|
---|
33 | ;
|
---|
34 | PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
|
---|
35 | 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)=""
|
---|
36 | D ^%ZTLOAD G END
|
---|
37 | ;
|
---|
38 | PRINT ;PRINT USAGE REPORT FOR ALL DRUGS BY AOU
|
---|
39 | S AOU=0,PGCT=1,QFLG="" I '$O(^TMP("PSGWUSE",$J,AOU)) D HDR W !!,"NO USAGE FOR SELECTED DATE RANGE." G DONE
|
---|
40 | AOULP S AOU=$O(^TMP("PSGWUSE",$J,AOU)) G:'AOU DONE I PGCT>1 D PRTCHK G:QFLG END
|
---|
41 | 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 ***"
|
---|
42 | 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
|
---|
43 | ;
|
---|
44 | DONE I $E(IOST)'="C" W @IOF
|
---|
45 | I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
|
---|
46 | 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
|
---|
47 | D ^%ZISC
|
---|
48 | S:$D(ZTQUEUED) ZTREQ="@" Q
|
---|
49 | ;
|
---|
50 | HDR ;PRINT REPORT HEADER
|
---|
51 | 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
|
---|
52 | W !,"ITEM",?35,"DISPENSE QUANTITY",!?42,"TOTAL",?49,"AUTO REPL",?60,"ON DEMAND",?72,"RETURNS" S PGCT=PGCT+1
|
---|
53 | W ! F J=1:1:80 W "-"
|
---|
54 | Q
|
---|
55 | PRTCHK ;
|
---|
56 | 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
|
---|
57 | D HDR Q
|
---|