Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXUPRO.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXUPRO.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXUPRO.m
r613 r623 1 ECXUPRO ;ALB/TJL-Prosthetic Extract Unusual Cost Report ; 1/08/08 1:00pm 2 ;;3.0;DSS EXTRACTS;**49,111**;July 1, 2003;Build 4 3 ; 4 EN ; 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 ; 23 BEGIN ; 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 ; 43 SELECT ; 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 ; 72 PROCESS ; 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 ; 78 PRINT ; process temp file and print report 79 N PG,QFLG,GTOT,LN,COUNT,FKEY,COST,SSN,REC,SDAY 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 SDAY="" F S SDAY=$O(^TMP($J,FKEY,COST,SDAY)) Q:SDAY=""!QFLG D 88 ...S SSN="" F S SSN=$O(^TMP($J,FKEY,COST,SDAY,SSN)) Q:SSN=""!QFLG S REC=^(SSN) D 89 ....S COUNT=COUNT+1 90 ....I $Y+3>IOSL D HEADER Q:QFLG 91 ....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) 92 Q:QFLG 93 I COUNT=0 W !!,?8,"No unusual costs to report for this extract" 94 CLOSE ; 95 I $E(IOST)="C",'QFLG D 96 .S SS=22-$Y F JJ=1:1:SS W ! 97 .S DIR(0)="E" W ! D ^DIR K DIR 98 Q 99 ; 100 HEADER ;header and page control 101 N SS,JJ 102 I $E(IOST)="C" D 103 .S SS=22-$Y F JJ=1:1:SS W ! 104 .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1 105 Q:QFLG 106 W:$Y!($E(IOST)="C") @IOF S PG=PG+1 107 W !,"Prosthetic Extract Unusual Cost Report",?124,"Page: "_PG 108 W !,"Start Date: ",ECSTART,?97,"Report Run Date/Time: "_ECRUN 109 W !," End Date: ",ECEND,?97," Threshold Value: ",ECTHLD 110 W !!,?21,"Date of",?43,"PCE CPT/",?112,"Cost of" 111 W !,"Name",?11,"SSN",?21,"Service",?36,"HCPCS CODE & Modifiers" 112 W ?72,"Feeder Key",?93,"Quantity",?110,"Transaction" 113 W !,LN,! 114 Q 115 ; 1 ECXUPRO ;ALB/TJL-Prosthetic Extract Unusual Cost Report ; 7/1/03 1:00pm 2 ;;3.0;DSS EXTRACTS;**49**;July 1, 2003 3 ; 4 EN ; 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 ; 23 BEGIN ; 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 ; 43 SELECT ; 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 ; 72 PROCESS ; 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 ; 78 PRINT ; 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" 93 CLOSE ; 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 ; 99 HEADER ;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 TracChangeset
for help on using the changeset viewer.
