source: FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXDRUG1.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1ECXDRUG1 ;ALB/TMD-Pharmacy Extracts Incomplete Feeder Key Report ; 2/17/04 3:23pm
2 ;;3.0;DSS EXTRACTS;**40,68**;Dec 22, 1997
3 ;
4EN ; entry point
5 N X,Y,DATE,ECRUN,ECXTL,ECSTART,ECEND,ECXDESC,ECXSAVE,ECXOPT,ECSD1,ECED,ECXERR,QFLG
6 S QFLG=0
7 ; get today's date
8 D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT
9 D BEGIN Q:QFLG
10 D SELECT Q:QFLG
11 S ECXDESC=ECXTL_" Extract Incomplete Feeder Key Report"
12 S ECXSAVE("EC*")=""
13 W !!,"This report requires 132 column format."
14 D EN^XUTMDEVQ("PROCESS^ECXDRUG1",ECXDESC,.ECXSAVE)
15 I POP W !!,"No device selected...exiting.",! Q
16 I IO'=IO(0) D ^%ZISC
17 D HOME^%ZIS
18 D AUDIT^ECXKILL
19 Q
20 ;
21BEGIN ; display report description
22 W @IOF,!,"This report prints a listing of Drug File (#50) entries that will generate",!,"incomplete Feeder keys in the three Pharmacy Extracts. This listing",!,"can be used to identify and fix Drug File entries. "
23 W "The number of extract",!,"records, total, quantity, unit price and total cost for each drug are",!,"included to aid in determining the impact of the incomplete Feeder Keys."
24 W !!,"This report is broken into 3 sections as follows:"
25 W !!,"Section 1: No PSNDF VA Product Name Entry (first 5 digits are zero)."
26 W !!,"Section 2: No National Drug Code (NDC) (last 12 digits are zero) or the NDC",!,?12,"is prefixed with an 'S', indicating possible supply item number",!,?12,"or UPC."
27 W !!,"Section 3: No PSNDF VA Product Name Entry, and"
28 W !,?14,"a. no NDC (all 17 digits are zero), or"
29 W !,?14,"b. The NDC is prefixed with an 'S', indicating possible supply",!,?17,"item number or UPC."
30 W !,"Section 3: No PSNDF VA Product Name Entry or NDC."
31 W !!,"Run times for this report will vary depending upon the size of the extract and",!,"could take as long as 30 minutes or more to complete. This report has no effect",!,"on the actual extracts and can be run as needed."
32 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
33 W:$Y!($E(IOST)="C") @IOF,!!
34 Q
35 ;
36SELECT ; user inputs for report option and date range
37 N DONE,OUT
38 ; allow user to select report option (PRE,IVP or UDP)
39 W "Choose the report you would like to run."
40 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
41 S ECXTL=$S(ECXOPT=1:"Prescription",ECXOPT=2:"IV Detail",ECXOPT=3:"Unit Dose Local",1:"")
42 ; allow user to select date range for report records
43 W !!,"Enter the date range for which you would like to scan the ",ECXTL,!,"Extract records."
44 S DONE=0 F S (ECED,ECSD)="" D Q:QFLG!DONE
45 .K %DT S %DT="AEX",%DT("A")="Starting with Date: ",%DT(0)=-DATE D ^%DT
46 .I Y<0 S QFLG=1 Q
47 .S ECSD=Y,ECSD1=ECSD-.1
48 .D DD^%DT S ECSTART=Y
49 .K %DT S %DT="AEX",%DT("A")="Ending with Date: ",%DT(0)=-DATE D ^%DT
50 .I Y<0 S QFLG=1 Q
51 .I Y<ECSD D Q
52 ..W !!,"The ending date cannot be earlier than the starting date."
53 ..W !,"Please try again.",!!
54 .I $E(Y,1,5)'=$E(ECSD,1,5) D Q
55 ..W !!,"Beginning and ending dates must be in the same month and year."
56 ..W !,"Please try again.",!!
57 .S ECED=Y
58 .D DD^%DT S ECEND=Y
59 .S DONE=1
60 Q
61 ;
62PROCESS ; entry point for queued report
63 S ZTREQ="@"
64 S ECXERR=0 D EN^ECXDRUG2 Q:ECXERR
65 S QFLG=0 D PRINT
66 Q
67 ;
68PRINT ; process temp file and print report
69 N PG,GTOT,LN,S,COUNT,SUBTOT,DR,ECTYPE,REC,STATS,ECCOUNT,ECQTY,ECPRC,ECCOST
70 U IO
71 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
72 S (PG,QFLG,GTOT)=0,$P(LN,"-",132)=""
73 F S=1:1:3 Q:QFLG D HEADER Q:QFLG D
74 .S (COUNT,SUBTOT)=0,DR="" F S DR=$O(^TMP($J,DR)) Q:DR=""!QFLG S ECTYPE=$P(^(DR),U,4) I ECTYPE=S D
75 ..S REC=^TMP($J,DR),STATS=^(DR,0)
76 ..S COUNT=COUNT+1
77 ..S ECCOUNT=$FNUMBER($P(STATS,U),",")
78 ..S ECQTY=$FNUMBER($P(STATS,U,2),",")
79 ..S ECPRC="$"_$FNUMBER($P(REC,U,3),",",4)
80 ..S ECCOST="$"_$FNUMBER($P(STATS,U,3),",",2)
81 ..S SUBTOT=SUBTOT+$P(STATS,U,3)
82 ..W !,$$RJ^XLFSTR(DR,5),?8,$P(REC,U),?60,$P(REC,U,2),?79,$$RJ^XLFSTR(ECCOUNT,5),?87,$$RJ^XLFSTR(ECQTY,10),?99,$$RJ^XLFSTR(ECPRC,16),?117,$$RJ^XLFSTR(ECCOST,13)
83 ..I $Y+2>IOSL D HEADER
84 .Q:QFLG
85 .I COUNT=0 W !!,?8,"No drugs to report for this section"
86 .; print sub total
87 .I COUNT D
88 ..I $Y+3>IOSL D HEADER Q:QFLG
89 ..S GTOT=GTOT+SUBTOT
90 ..S SUBTOT="$"_$FNUMBER(SUBTOT,",",2)
91 ..W !!,?110,"TOTAL",?116,$$RJ^XLFSTR(SUBTOT,14)
92 ; print grand total
93 I GTOT,'QFLG D
94 .I $Y+3>IOSL D HEADER Q:QFLG
95 .S GTOT="$"_$FNUMBER(GTOT,",",2)
96 .W !!,?104,"GRAND TOTAL",?116,$$RJ^XLFSTR(GTOT,14)
97 ;
98CLOSE ;
99 I $E(IOST)="C",'QFLG D
100 .S SS=22-$Y F JJ=1:1:SS W !
101 .S DIR(0)="E" W ! D ^DIR K DIR
102 Q
103 ;
104HEADER ; header and page control
105 N SS,JJ
106 I $E(IOST)="C" D
107 .S SS=22-$Y F JJ=1:1:SS W !
108 .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1
109 Q:QFLG
110 W:$Y!($E(IOST)="C") @IOF S PG=PG+1
111 W !,ECXTL_" Extract Incomplete Feeder Key Report",?124,"Page: "_PG
112 W !,"Start Date: ",ECSTART
113 W !,"End Date: ",ECEND,?97,"Report Run Date/Time: "_ECRUN
114 W !!,"Drug",?8,"Generic Name",?60,"Feeder Key",?79,"# of",?89,"Total",?107,"Unit",?122,"Total"
115 W !,"Entry",?79,"Records",?89,"Quantity",?107,"Price",?122,"Cost"
116 W !,LN
117 I S=1 W !!,"No PSNDF VA Product Name Entry (Five leading zeros)",!
118 I S=2 W !!,"No National Drug Code (NDC) (Last 12 zeros, 'N/A', or 'S' prefix)",!
119 I S=3 W !!,"No PSNDF VA Product Name Entry or National Drug Code (NDC)",!
120 Q
121 ;
Note: See TracBrowser for help on using the repository browser.