source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECXAPHA.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.0 KB
Line 
1ECXAPHA ;ALB/TMD-Pharmacy Extracts Unusual Volumes Report ; 12/22/03 10:20am
2 ;;3.0;DSS EXTRACTS;**40,49,66,104,109**;Dec 22, 1997;Build 2
3 ;
4EN ; entry point
5 N X,Y,DATE,ECRUN,ECXOPT,ECXDESC,ECXSAVE,ECXTL,ECTHLD,ECSD
6 N ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG
7 S QFLG=0
8 ; get today's date
9 D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT
10 D BEGIN Q:QFLG
11 D SELECT Q:QFLG
12 S ECXDESC=ECXTL_" Extract Unusual Volume Report"
13 S ECXSAVE("EC*")=""
14 W !!,"This report requires 132-column format."
15 D EN^XUTMDEVQ("PROCESS^ECXAPHA",ECXDESC,.ECXSAVE)
16 I POP W !!,"No device selected...exiting.",! Q
17 I IO'=IO(0) D ^%ZISC
18 D HOME^%ZIS
19 D AUDIT^ECXKILL
20 Q
21 ;
22BEGIN ; display report description
23 W @IOF
24 W !,"This report prints a listing of unusual volumes that would be"
25 W !,"generated by the pharmacy extracts (PRE, IVP and UDP) as"
26 W !,"determined by a user defined threshold value. It shoud be run"
27 W !,"prior to the generation of the actual extract(s) to identify and"
28 W !,"fix as necessary any volumes determined to be erroneous."
29 W !!,"Unusual volumes are defined as follows:"
30 W !!,"PRE Extract: Quantity field greater than the threshold value."
31 W !,"IVP Extract: Total Doses Per Day field greater than the threshold"
32 W !,?14,"or less than the negative of the threshold value."
33 W !,"UDP Extract: Quantity field greater than threshold value."
34 W !!,"Note: The threshold can be set after a report is selected."
35 W !!,"Run times for this report will vary depending upon the size of"
36 W !,"the extract and could take as long as 30 minutes or more to"
37 W !,"complete. This report has no effect on the actual extracts and"
38 W !,"can be run as needed."
39 W !!,"The report is sorted by Feeder Key, descending Volume, and SSN."
40 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
41 W:$Y!($E(IOST)="C") @IOF,!!
42 Q
43 ;
44SELECT ; user inputs for report option, threshold volume and date range
45 N DONE,OUT
46 ; allow user to select report option (PRE,IVP or UDP)
47 W "Choose the report you would like to run."
48 S DIR(0)="S^1:PRE;2:IVP;3:UDP",DIR("A")="Selection",DIR("B")=1 D ^DIR K DIR S ECXOPT=Y I X["^" S QFLG=1 Q
49 S ECXTL=$S(ECXOPT=1:"Prescription",ECXOPT=2:"IV Detail",ECXOPT=3:"Unit Dose Local",1:"")
50 ; allow user to set threshold volume
51 S ECTHLD=$S(ECXOPT=2:1000,1:500)
52 W !!,"The default threshold volume for the ",ECXTL," extract is ",ECTHLD,"."
53 S DIR(0)="Y",DIR("A")="Would you like to change the threshold",DIR("B")="NO" D ^DIR K DIR I X["^" S QFLG=1 Q
54 I Y D
55 .W !!,$S(ECXOPT=2:"threshold > Total Doses Per Day < -threshold",1:"Quantity > threshold")
56 .S DIR(0)="N^0:100000:0",DIR("A")="Enter the new threshold volume" D ^DIR K DIR S ECTHLD=Y I X["^" S QFLG=1 Q
57 ; get date range from user
58 W !!,"Enter the date range for which you would like to scan the ",ECXTL,!,"Extract records."
59 S DONE=0 F S (ECED,ECSD)="" D Q:QFLG!DONE
60 .K %DT S %DT="AEX",%DT("A")="Starting with Date: ",%DT(0)=-DATE D ^%DT
61 .I Y<0 S QFLG=1 Q
62 .S ECSD=Y,ECSD1=ECSD-.1
63 .D DD^%DT S ECSTART=Y
64 .K %DT S %DT="AEX",%DT("A")="Ending with Date: ",%DT(0)=-DATE D ^%DT
65 .I Y<0 S QFLG=1 Q
66 .I Y<ECSD D Q
67 ..W !!,"The ending date cannot be earlier than the starting date."
68 ..W !,"Please try again.",!!
69 .I $E(Y,1,5)'=$E(ECSD,1,5) D Q
70 ..W !!,"Beginning and ending dates must be in the same month and year."
71 ..W !,"Please try again.",!!
72 .S ECED=Y
73 .D DD^%DT S ECEND=Y
74 .S DONE=1
75 Q
76 ;
77PROCESS ; entry point for queued report
78 S ZTREQ="@"
79 S ECXERR=0 D EN^ECXAPHA2 Q:ECXERR
80 S QFLG=0 D PRINT
81 Q
82 ;
83PRINT ; process temp file and print report
84 N PG,QFLG,GTOT,LN,COUNT,FKEY,QTY,SSN,REC,EDAY
85 U IO
86 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
87 S (PG,QFLG,GTOT)=0,$P(LN,"-",132)=""
88 D HEADER Q:QFLG
89 S COUNT=0,FKEY="" F S FKEY=$O(^TMP($J,FKEY)) Q:FKEY=""!QFLG D
90 .S QTY="" F S QTY=$O(^TMP($J,FKEY,QTY)) Q:QTY=""!QFLG D
91 ..S EDAY="" F S EDAY=$O(^TMP($J,FKEY,QTY,EDAY)) Q:EDAY=""!QFLG D
92 ...S SSN=""
93 ...F S SSN=$O(^TMP($J,FKEY,QTY,EDAY,SSN)) Q:SSN=""!QFLG S REC=^(SSN) D
94 ....S COUNT=COUNT+1
95 ....I $Y+3>IOSL D HEADER Q:QFLG
96 ....W !,$P(REC,U),?8,$P(REC,U,2),?20,$P(REC,U,3),?29,$E($P(REC,U,4),1,40)
97 ....W ?71,$P(REC,U,5),?89,$$RJ^XLFSTR($P(REC,U,6),9)_" "_$E($P(REC,U,7),1,7)
98 ....I ECXOPT=1 D
99 .....W ?108,$$RJ^XLFSTR($P(REC,U,8),12),?125,$$RJ^XLFSTR($P(REC,U,9),3)
100 ....I ECXOPT'=1 D
101 .....W ?116,$$RJ^XLFSTR($P(REC,U,8),14)
102 Q:QFLG
103 I COUNT=0 W !!,?8,"No unusual volumes to report for this extract"
104CLOSE ;
105 I $E(IOST)="C",'QFLG D
106 .S SS=22-$Y F JJ=1:1:SS W !
107 .S DIR(0)="E" W ! D ^DIR K DIR
108 Q
109 ;
110HEADER ;header and page control
111 N SS,JJ
112 I $E(IOST)="C" D
113 .S SS=22-$Y F JJ=1:1:SS W !
114 .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1
115 Q:QFLG
116 W:$Y!($E(IOST)="C") @IOF S PG=PG+1
117 W !,ECXTL_" Extract Unusual Volume Report",?124,"Page: "_PG
118 W !,"Start Date: ",ECSTART,?97,"Report Run Date/Time: "_ECRUN
119 W !,"End Date: ",ECEND,?97,"Threshold Value = ",ECTHLD
120 W !!,"Name",?11,"SSN",?21,"Day",?29,"Generic Name",?71,"Feeder Key"
121 I ECXOPT=1 D
122 .W ?95,"Quantity",?109,"Total Cost",?120,"Days Supply"
123 E D
124 .I ECXOPT=2 W ?93,"Total Doses",?121,"Total Cost",!,?95,"Per Day"
125 .I ECXOPT'=2 W ?96,"Quantity",?121,"Total Cost"
126 W !,LN,!
127 Q
128 ;
Note: See TracBrowser for help on using the repository browser.