source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXUPRO.m@ 1005

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

revised back to 6/30/08 version

File size: 4.1 KB
Line 
1ECXUPRO ;ALB/TJL-Prosthetic Extract Unusual Cost Report ; 7/1/03 1:00pm
2 ;;3.0;DSS EXTRACTS;**49**;July 1, 2003
3 ;
4EN ; entry point
5 N X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD
6 N ECINST,ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG
7 S QFLG=0
8 S ECINST=$$PDIV^ECXPUTL
9 ; get today's date
10 D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT
11 D BEGIN Q:QFLG
12 D SELECT Q:QFLG
13 S ECXDESC="Prosthetic Extract Unusual Cost Report"
14 S ECXSAVE("EC*")=""
15 W !!,"This report requires 132-column format."
16 D EN^XUTMDEVQ("PROCESS^ECXUPRO",ECXDESC,.ECXSAVE)
17 I POP W !!,"No device selected...exiting.",! Q
18 I IO'=IO(0) D ^%ZISC
19 D HOME^%ZIS
20 D AUDIT^ECXKILL
21 Q
22 ;
23BEGIN ; display report description
24 W @IOF
25 W !,"This report prints a listing of unusual costs that would be"
26 W !,"generated by the Prosthetic extract (PRO) as determined by a"
27 W !,"user-defined threshold value. It should be run prior to the"
28 W !,"generation of the actual extract(s) to identify and fix, as"
29 W !,"necessary, any costs determined to be erroneous."
30 W !!,"Unusual costs are those where the Cost of Transaction is"
31 W !,"greater than the threshold value."
32 W !!,"Note: The threshold can be set after a report is selected."
33 W !!,"Run times for this report will vary depending upon the size of"
34 W !,"the extract and could take as long as 30 minutes or more to"
35 W !,"complete. This report has no effect on the actual extracts and"
36 W !,"can be run as needed."
37 W !!,"The report is sorted by Feeder Key, then by descending Cost of"
38 W !,"Transaction and SSN."
39 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
40 W:$Y!($E(IOST)="C") @IOF,!!
41 Q
42 ;
43SELECT ; user inputs for threshold cost and date range
44 N DONE,OUT
45 ; allow user to set threshold cost
46 S ECTHLD=500
47 W !!,"The default threshold cost for the Prosthetic extract is $"_ECTHLD_".00."
48 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
49 I Y D
50 .W !!,"Cost > threshold"
51 .S DIR(0)="N^0:999999",DIR("A")="Enter the new threshold cost" D ^DIR K DIR S ECTHLD=Y I X["^" S QFLG=1 Q
52 ; get date range from user
53 W !!,"Enter the date range for which you would like to scan the Prosthetic",!,"Extract records.",!
54 S DONE=0 F S (ECED,ECSD)="" D Q:QFLG!DONE
55 .K %DT S %DT="AEX",%DT("A")="Starting with Date: ",%DT(0)=-DATE D ^%DT
56 .I Y<0 S QFLG=1 Q
57 .S ECSD=Y,ECSD1=ECSD-.1
58 .D DD^%DT S ECSTART=Y
59 .K %DT S %DT="AEX",%DT("A")="Ending with Date: ",%DT(0)=-DATE D ^%DT
60 .I Y<0 S QFLG=1 Q
61 .I Y<ECSD D Q
62 ..W !!,"The ending date cannot be earlier than the starting date."
63 ..W !,"Please try again.",!!
64 .I $E(Y,1,5)'=$E(ECSD,1,5) D Q
65 ..W !!,"Beginning and ending dates must be in the same month and year."
66 ..W !,"Please try again.",!!
67 .S ECED=Y
68 .D DD^%DT S ECEND=Y
69 .S DONE=1
70 Q
71 ;
72PROCESS ; entry point for queued report
73 S ZTREQ="@"
74 S ECXERR=0 D EN^ECXUPRO1 Q:ECXERR
75 S QFLG=0 D PRINT
76 Q
77 ;
78PRINT ; process temp file and print report
79 N PG,QFLG,GTOT,LN,COUNT,FKEY,COST,SSN,REC
80 U IO
81 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
82 S (PG,QFLG,GTOT)=0,$P(LN,"-",132)=""
83 D HEADER Q:QFLG
84 S COUNT=0,FKEY=""
85 F S FKEY=$O(^TMP($J,FKEY)) Q:FKEY=""!QFLG D
86 .S COST="" F S COST=$O(^TMP($J,FKEY,COST)) Q:COST=""!QFLG D
87 ..S SSN="" F S SSN=$O(^TMP($J,FKEY,COST,SSN)) Q:SSN=""!QFLG S REC=^(SSN) D
88 ...S COUNT=COUNT+1
89 ...I $Y+3>IOSL D HEADER Q:QFLG
90 ...W !,$P(REC,U),?8,$P(REC,U,2),?21,$P(REC,U,3),?39,$P(REC,U,4),?70,$P(REC,U,5),?93,$$RJ^XLFSTR($P(REC,U,6),8),?110,$$RJ^XLFSTR($P(REC,U,7),11)
91 Q:QFLG
92 I COUNT=0 W !!,?8,"No unusual costs to report for this extract"
93CLOSE ;
94 I $E(IOST)="C",'QFLG D
95 .S SS=22-$Y F JJ=1:1:SS W !
96 .S DIR(0)="E" W ! D ^DIR K DIR
97 Q
98 ;
99HEADER ;header and page control
100 N SS,JJ
101 I $E(IOST)="C" D
102 .S SS=22-$Y F JJ=1:1:SS W !
103 .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1
104 Q:QFLG
105 W:$Y!($E(IOST)="C") @IOF S PG=PG+1
106 W !,"Prosthetic Extract Unusual Cost Report",?124,"Page: "_PG
107 W !,"Start Date: ",ECSTART,?97,"Report Run Date/Time: "_ECRUN
108 W !," End Date: ",ECEND,?97," Threshold Value: ",ECTHLD
109 W !!,?21,"Date of",?43,"PCE CPT/",?112,"Cost of"
110 W !,"Name",?11,"SSN",?21,"Service",?36,"HCPCS CODE & Modifiers"
111 W ?72,"Feeder Key",?93,"Quantity",?110,"Transaction"
112 W !,LN,!
113 Q
114 ;
Note: See TracBrowser for help on using the repository browser.