source: FOIAVistA/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWTOT1.m@ 868

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1PSGWTOT1 ;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
3ENQ ;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)=""
7AOU I AOUFL=1 S AOU=$O(^PSI(58.1,AOU)) G:('AOU)&($D(ZTQUEUED)) PRTQUE G:'AOU PRINT
8DRUG ;LOOP THROUGH DRUGS FOR AOU
9 S DRGDA=0
10DRGLP 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 ;
14AR ;AUTOMATIC REPLENISHMENT INVENTORIES
15 S (DRGQD,INVDA,ARQD,ODQD,RTQD)=0
16INVLP 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 ;
20OD ;ON DEMAND REQUESTS
21 S ODA=0
22ODLP 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 ;
26RET ;RETURNS
27 S RETDT=0
28RETLP 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 ;
32SETGL S:DRGQD>0 ^TMP("PSGWUSE",$J,AOU,DRGNAME)=DRGQD_"^"_ARQD_"^"_ODQD_"^"_RTQD G DRGLP
33 ;
34PRTQUE ;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 ;
38PRINT ;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
40AOULP 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 ***"
42DRLP 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 ;
44DONE I $E(IOST)'="C" W @IOF
45 I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
46END 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 ;
50HDR ;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
55PRTCHK ;
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
Note: See TracBrowser for help on using the repository browser.