| [613] | 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 | ;
|
|---|
