source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWTOT2.m@ 975

Last change on this file since 975 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PSGWTOT2 ;BHAM ISC/PTD,CML-Print Usage Report for Single Drug for One or ALL AOUs ; 23 Mar 93 / 1:03 PM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3ENQ ;ENTRY POINT WHEN QUEUED.
4 K ^TMP("PSGWUSE",$J)
5AOULP I AOUFL=1 S AOU=$O(^PSI(58.1,AOU)) G:('AOU)&($D(ZTQUEUED)) PRTQUE G:'AOU PRINT
6 S DRGDA=0
7DRG 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
8 ;
9AR ;INVENTORIES
10 S INVDA=0
11INVLP 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:"")
12 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
13 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)
14 G INVLP
15 ;
16OD ;ON DEMANDS
17 S ODA=0
18ODLP 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),"^")
19 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)
20 G ODLP
21 ;
22RET ;RETURNS
23 S RETDT=0
24RETLP S RETDT=$O(^PSI(58.1,AOU,1,DRGDA,3,RETDT)) G:'RETDT DRG
25 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)
26 G RETLP
27 ;
28PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
29 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)=""
30 D ^%ZTLOAD G END
31 ;
32PRINT ;PRINT USAGE REPORT FOR SINGLE DRUG BY AOU
33 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
34 D HDR
35AOU 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
36TYP 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"
37DT S INVDT=$O(^TMP("PSGWUSE",$J,AOU,TYP,INVDT)) G:'INVDT SUBTOT S QD=$P(^TMP("PSGWUSE",$J,AOU,TYP,INVDT),"^")
38 I TYP="AR" S ARQD=ARQD+QD,DRGQD=DRGQD+QD
39 I TYP="OD" S ODQD=ODQD+QD,DRGQD=DRGQD+QD
40 I TYP="RT" S RTQD=RTQD+QD,DRGQD=DRGQD-QD
41 D:$Y+5>IOSL PRTCHK G:QFLG END D WRTLN G DT
42 ;
43DONE I $E(IOST)'="C" W @IOF
44 I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
45END 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
46 D ^%ZISC
47 S:$D(ZTQUEUED) ZTREQ="@" Q
48 ;
49HDR ;
50 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
51 W !?5,"AREA OF USE",?55,"DATE: ",$$PSGWDT^PSGWUTL1,!,"ITEM",?15,"INVENTORY DATE",?35,"DISPENSE QUANTITY",! F J=1:1:80 W "-"
52 Q
53SUB ;
54 I $Y+5>IOSL D PRTCHK I QFLG Q
55 W !!?5,"==> ",$P(^PSI(58.1,AOU,0),"^"),!,ITNAM,!!
56 Q
57 ;
58WRTLN S Y=INVDT X ^DD("DD") W !?15,$P(Y,"@")," ",$P(Y,"@",2),?43,$J(QD,4) Q
59SUBTOT ;
60 I $Y+5>IOSL D PRTCHK I QFLG Q
61 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),!
62 G TYP
63 ;
64TOTAL W !?42,"=======",!,"TOTAL DISPENSED",?43,$J(DRGQD,4) S GRTOT=GRTOT+DRGQD
65 Q
66GRTOT ;
67 I $Y+5>IOSL D PRTCHK I QFLG Q
68 W !!?38 F J=1:1:15 W "="
69 W !,"TOTAL USAGE FOR ALL AREAS IS:",?43,$J(GRTOT,4)
70 Q
71PRTCHK ;
72 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
73 D HDR Q
Note: See TracBrowser for help on using the repository browser.