ECXUPRO ;ALB/TJL-Prosthetic Pre-Extract Unusual Cost Report ;6/1/17 15:32
;;3.0;DSS EXTRACTS;**49,111,144,148,149,154,161,166,187**;Dec 22, 1997;Build 163
;
; Reference to ^%DT in ICR #10003
; Reference to ^%DTC in ICR #10000
; Reference to ^XUTMDEVQ in ICR #1519
; Reference to ^XLFSTR in ICR #10104
; Reference to ^TMP supported by SACC 2.3.2.5.1
;
EN ; entry point
N X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD,ECXPORT,CNT ;144
N ECINST,ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG
N ECXPROUN ;187
S QFLG=0
S ECINST=$$PDIV^ECXPUTL
; get today's date
D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT
D BEGIN Q:QFLG
D SELECT Q:QFLG
S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I ECXPORT D Q ;144
.K ^TMP($J) ;144
.;S ^TMP($J,"ECXPORT",0)="NAME^SSN^DATE OF SERVICE^FORM^FORM DESCRIPTION^PSAS HCPCS CODE^FEEDER KEY^QUANTITY^COST OF TRANSACTION^TRANSACTION TYPE^TRAN TYPE DESC" ;144,149,154,161
.S ^TMP($J,"ECXPORT",0)="NAME^SSN^DATE OF SERVICE^FORM^FORM DESCRIPTION^FEEDER KEY^PSAS HCPCS CODE^PSAS HCPCS CODE DESCRIPTION^TRANSACTION TYPE^TRANSACTION TYPE DESCRIPTION^QUANTITY^" ;187 - Re-arrange columns
.S ^TMP($J,"ECXPORT",0)=^TMP($J,"ECXPORT",0)_"UNIT OF ISSUE^UNIT OF ISSUE DESCRIPTION^COST OF TRANSACTION" ;187 Re-arrange columns
.S CNT=1 ;144
.D PROCESS ;144
.D EXPDISP^ECXUTL1 ;144
;device selection
S ECXDESC="Prosthetic Pre-Extract Unusual Cost Report" ;tjl 166 Changed report title
S ECXSAVE("EC*")=""
W !!,"This report requires 132-column format."
D EN^XUTMDEVQ("PROCESS^ECXUPRO",ECXDESC,.ECXSAVE)
I POP W !!,"No device selected...exiting.",! Q
I IO'=IO(0) D ^%ZISC
D HOME^%ZIS
D AUDIT^ECXKILL
Q
;
BEGIN ; display report description
W @IOF
W !,"This report prints a listing of unusual costs that would be"
W !,"generated by the Prosthetic extract (PRO) as determined by a"
W !,"user-defined threshold value. It should be run prior to the"
W !,"generation of the actual extract(s) to identify and fix, as"
W !,"necessary, any costs determined to be erroneous."
W !!,"Unusual costs are those where the Cost of Transaction is"
W !,"greater than the threshold value."
W !!,"Note: The threshold can be set after a report is selected."
W !!,"Run times for this report will vary depending upon the size of"
W !,"the extract and could take as long as 30 minutes or more to"
W !,"complete. This report has no effect on the actual extracts and"
W !,"can be run as needed."
W !!,"The report is sorted by Feeder Key, then by descending Cost of"
W !,"Transaction and SSN."
W !!,"**NOTE: The feeder key on this report will match what appears in DSS.",!,"However, the feeder key on the report will be different than the feeder",!,"key on the PRO extract." ;149
S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
W:$Y!($E(IOST)="C") @IOF,!!
Q
;
SELECT ; user inputs for threshold cost and date range
N DONE,OUT
; allow user to set threshold cost
S ECTHLD=500
W !!,"The default threshold cost for the Prosthetic extract is $"_ECTHLD_".00."
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
I Y D
.W !!,"Cost > threshold"
.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
; get date range from user
W !!,"Enter the date range for which you would like to scan the Prosthetic",!,"Extract records.",!
S DONE=0 F S (ECED,ECSD)="" D Q:QFLG!DONE
.K %DT S %DT="AEX",%DT("A")="Starting with Date: ",%DT(0)=-DATE D ^%DT
.I Y<0 S QFLG=1 Q
.S ECSD=Y,ECSD1=ECSD-.1
.D DD^%DT S ECSTART=Y
.K %DT S %DT="AEX",%DT("A")="Ending with Date: ",%DT(0)=-DATE D ^%DT
.I Y<0 S QFLG=1 Q
.I Y<ECSD D Q
..W !!,"The ending date cannot be earlier than the starting date."
..W !,"Please try again.",!!
.I $E(Y,1,5)'=$E(ECSD,1,5) D Q
..W !!,"Beginning and ending dates must be in the same month and year."
..W !,"Please try again.",!!
.S ECED=Y
.D DD^%DT S ECEND=Y
.S DONE=1
Q
;
PROCESS ; entry point for queued report
S ZTREQ="@"
S ECXERR=0 D EN^ECXUPRO1 Q:ECXERR
S QFLG=0 D PRINT
Q
;
PRINT ; process temp file and print report
N PG,QFLG,GTOT,LN,COUNT,FKEY,COST,SSN,REC,SDAY,I,SPACE,UNIT ;144,161,187 - Added UNIT
U IO
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
S (PG,QFLG,GTOT)=0,$P(LN,"-",132)=""
I '$G(ECXPORT) D HEADER Q:QFLG ;144
S COUNT=0,FKEY=""
F S FKEY=$O(^TMP($J,FKEY)) Q:FKEY=""!QFLG D
.S COST="" F S COST=$O(^TMP($J,FKEY,COST)) Q:COST=""!QFLG D
.. S SDAY="" F S SDAY=$O(^TMP($J,FKEY,COST,SDAY)) Q:SDAY=""!QFLG D
...S SSN="" F S SSN=$O(^TMP($J,FKEY,COST,SDAY,SSN)) Q:SSN=""!QFLG S REC=^(SSN) D
....I $G(ECXPORT) S ^TMP($J,"ECXPORT",CNT)=REC,CNT=CNT+1 Q ;144
....S COUNT=COUNT+1
....I $Y+3>IOSL D HEADER Q:QFLG
....;W !,$P(REC,U),?8,$P(REC,U,2),?21,$P(REC,U,3),?39,$P(REC,U,4),?45,$P(REC,U,5),?70,$P(REC,U,6),?93,$$RJ^XLFSTR($P(REC,U,7),8),?110,$$RJ^XLFSTR($P(REC,U,8),11),?127,$P(REC,U,9) ;149,154
....W !,$P(REC,U),?8,$P(REC,U,2),?19,$P(REC,U,3),?30,$P(REC,U,4),?36,$P(REC,U,5),?58,$P(REC,U,6),?66,$E($P(REC,U,7),1,30),?100,$P(REC,U,8) ;187 Re-arrange the columns
....W ?103,$P(REC,U,10),?109,$$RJ^XLFSTR($P(REC,U,11),4),?117,$$RJ^XLFSTR($P(REC,U,12),13) ;187 re-arrange the columns
Q:QFLG!($G(ECXPORT)) ;144
I COUNT=0 W !!,?8,"No unusual costs to report for this extract"
I COUNT D ;154,161 Print key to forms and trans type,187 - Added Unit of Issue
.I $Y+7>IOSL D HEADER Q:QFLG ;Make sure there's enough room for the footer info
.W ! D FOOTER^ECXPROCT
.S SPACE=$$REPEAT^XLFSTR(" ",10)
.W !!,"TRAN TYPE:",!,"I:INITIAL ISSUE",SPACE,"R:REPLACE",SPACE,"S:SPARE",SPACE,"X:REPAIR",SPACE,"5:RENTAL"
.W !!,"UNIT OF ISSUE:",! ;187
.S SPACE=$$REPEAT^XLFSTR(" ",5) ;187
.S UNIT="" ;187
.F S UNIT=$O(ECXPROUN(UNIT)) Q:UNIT="" D ;187
..W UNIT_":",ECXPROUN(UNIT),SPACE
..Q:$X>120
.Q
CLOSE ;
I $E(IOST)="C",'QFLG D
.S SS=22-$Y F JJ=1:1:SS W !
.S DIR(0)="E" W ! D ^DIR K DIR
Q
;
N SS,JJ
I $E(IOST)="C" D
.S SS=22-$Y F JJ=1:1:SS W !
.I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1
Q:QFLG
W:$Y!($E(IOST)="C") @IOF S PG=PG+1
W !,"Prosthetic Pre-Extract Unusual Cost Report",?124,"Page: "_PG ;tjl 166 Changed report title
W !,"Start Date: ",ECSTART,?97,"Report Run Date/Time: "_ECRUN
W !," End Date: ",ECEND,?97," Threshold Value: ",ECTHLD
;W !!,?21,"Date of",?45,"PSAS",?112,"Cost of",?126,"Tran" ;149,154
;W !,"Name",?11,"SSN",?21,"Service",?39,"FORM",?45,"HCPCS CODE" ;149,154
;W ?70,"Feeder Key",?93,"Quantity",?110,"Transaction",?126,"Type" ;149
W !!,?19,"Date of",?62,"PSAS HCPCS",?98,"Tran",?109,"Unit of",?119,"Cost of" ;187 Re-arrange the columns
W !,"Name",?11,"SSN",?19,"Service",?30,"FORM",?36,"Feeder Key",?58,"CODE Description",?98,"Type" ;187
W ?104,"QTY",?109,"Issue",?119,"Transaction" ;187
W !,LN,!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXUPRO 6968 printed Dec 13, 2024@01:54:18 Page 2
ECXUPRO ;ALB/TJL-Prosthetic Pre-Extract Unusual Cost Report ;6/1/17 15:32
+1 ;;3.0;DSS EXTRACTS;**49,111,144,148,149,154,161,166,187**;Dec 22, 1997;Build 163
+2 ;
+3 ; Reference to ^%DT in ICR #10003
+4 ; Reference to ^%DTC in ICR #10000
+5 ; Reference to ^XUTMDEVQ in ICR #1519
+6 ; Reference to ^XLFSTR in ICR #10104
+7 ; Reference to ^TMP supported by SACC 2.3.2.5.1
+8 ;
EN ; entry point
+1 ;144
NEW X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD,ECXPORT,CNT
+2 NEW ECINST,ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG
+3 ;187
NEW ECXPROUN
+4 SET QFLG=0
+5 SET ECINST=$$PDIV^ECXPUTL
+6 ; get today's date
+7 DO NOW^%DTC
SET DATE=X
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET ECRUN=$PIECE(Y,"@")
KILL %DT
+8 DO BEGIN
if QFLG
QUIT
+9 DO SELECT
if QFLG
QUIT
+10 ;144
SET ECXPORT=$$EXPORT^ECXUTL1
if ECXPORT=-1
QUIT
IF ECXPORT
Begin DoDot:1
+11 ;144
KILL ^TMP($JOB)
+12 ;S ^TMP($J,"ECXPORT",0)="NAME^SSN^DATE OF SERVICE^FORM^FORM DESCRIPTION^PSAS HCPCS CODE^FEEDER KEY^QUANTITY^COST OF TRANSACTION^TRANSACTION TYPE^TRAN TYPE DESC" ;144,149,154,161
+13 ;187 - Re-arrange columns
SET ^TMP($JOB,"ECXPORT",0)="NAME^SSN^DATE OF SERVICE^FORM^FORM DESCRIPTION^FEEDER KEY^PSAS HCPCS CODE^PSAS HCPCS CODE DESCRIPTION^TRANSACTION TYPE^TRANSACTION TYPE DESCRIPTION^QUANTITY^"
+14 ;187 Re-arrange columns
SET ^TMP($JOB,"ECXPORT",0)=^TMP($JOB,"ECXPORT",0)_"UNIT OF ISSUE^UNIT OF ISSUE DESCRIPTION^COST OF TRANSACTION"
+15 ;144
SET CNT=1
+16 ;144
DO PROCESS
+17 ;144
DO EXPDISP^ECXUTL1
End DoDot:1
QUIT
+18 ;device selection
+19 ;tjl 166 Changed report title
SET ECXDESC="Prosthetic Pre-Extract Unusual Cost Report"
+20 SET ECXSAVE("EC*")=""
+21 WRITE !!,"This report requires 132-column format."
+22 DO EN^XUTMDEVQ("PROCESS^ECXUPRO",ECXDESC,.ECXSAVE)
+23 IF POP
WRITE !!,"No device selected...exiting.",!
QUIT
+24 IF IO'=IO(0)
DO ^%ZISC
+25 DO HOME^%ZIS
+26 DO AUDIT^ECXKILL
+27 QUIT
+28 ;
BEGIN ; display report description
+1 WRITE @IOF
+2 WRITE !,"This report prints a listing of unusual costs that would be"
+3 WRITE !,"generated by the Prosthetic extract (PRO) as determined by a"
+4 WRITE !,"user-defined threshold value. It should be run prior to the"
+5 WRITE !,"generation of the actual extract(s) to identify and fix, as"
+6 WRITE !,"necessary, any costs determined to be erroneous."
+7 WRITE !!,"Unusual costs are those where the Cost of Transaction is"
+8 WRITE !,"greater than the threshold value."
+9 WRITE !!,"Note: The threshold can be set after a report is selected."
+10 WRITE !!,"Run times for this report will vary depending upon the size of"
+11 WRITE !,"the extract and could take as long as 30 minutes or more to"
+12 WRITE !,"complete. This report has no effect on the actual extracts and"
+13 WRITE !,"can be run as needed."
+14 WRITE !!,"The report is sorted by Feeder Key, then by descending Cost of"
+15 WRITE !,"Transaction and SSN."
+16 ;149
WRITE !!,"**NOTE: The feeder key on this report will match what appears in DSS.",!,"However, the feeder key on the report will be different than the feeder",!,"key on the PRO extract."
+17 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET QFLG=1
QUIT
+18 if $Y!($EXTRACT(IOST)="C")
WRITE @IOF,!!
+19 QUIT
+20 ;
SELECT ; user inputs for threshold cost and date range
+1 NEW DONE,OUT
+2 ; allow user to set threshold cost
+3 SET ECTHLD=500
+4 WRITE !!,"The default threshold cost for the Prosthetic extract is $"_ECTHLD_".00."
+5 SET DIR(0)="Y"
SET DIR("A")="Would you like to change the threshold?"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF X["^"
SET QFLG=1
QUIT
+6 IF Y
Begin DoDot:1
+7 WRITE !!,"Cost > threshold"
+8 SET DIR(0)="N^0:999999"
SET DIR("A")="Enter the new threshold cost"
DO ^DIR
KILL DIR
SET ECTHLD=Y
IF X["^"
SET QFLG=1
QUIT
End DoDot:1
+9 ; get date range from user
+10 WRITE !!,"Enter the date range for which you would like to scan the Prosthetic",!,"Extract records.",!
+11 SET DONE=0
FOR
SET (ECED,ECSD)=""
Begin DoDot:1
+12 KILL %DT
SET %DT="AEX"
SET %DT("A")="Starting with Date: "
SET %DT(0)=-DATE
DO ^%DT
+13 IF Y<0
SET QFLG=1
QUIT
+14 SET ECSD=Y
SET ECSD1=ECSD-.1
+15 DO DD^%DT
SET ECSTART=Y
+16 KILL %DT
SET %DT="AEX"
SET %DT("A")="Ending with Date: "
SET %DT(0)=-DATE
DO ^%DT
+17 IF Y<0
SET QFLG=1
QUIT
+18 IF Y<ECSD
Begin DoDot:2
+19 WRITE !!,"The ending date cannot be earlier than the starting date."
+20 WRITE !,"Please try again.",!!
End DoDot:2
QUIT
+21 IF $EXTRACT(Y,1,5)'=$EXTRACT(ECSD,1,5)
Begin DoDot:2
+22 WRITE !!,"Beginning and ending dates must be in the same month and year."
+23 WRITE !,"Please try again.",!!
End DoDot:2
QUIT
+24 SET ECED=Y
+25 DO DD^%DT
SET ECEND=Y
+26 SET DONE=1
End DoDot:1
if QFLG!DONE
QUIT
+27 QUIT
+28 ;
PROCESS ; entry point for queued report
+1 SET ZTREQ="@"
+2 SET ECXERR=0
DO EN^ECXUPRO1
if ECXERR
QUIT
+3 SET QFLG=0
DO PRINT
+4 QUIT
+5 ;
PRINT ; process temp file and print report
+1 ;144,161,187 - Added UNIT
NEW PG,QFLG,GTOT,LN,COUNT,FKEY,COST,SSN,REC,SDAY,I,SPACE,UNIT
+2 USE IO
+3 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
KILL ZTREQ
QUIT
+4 SET (PG,QFLG,GTOT)=0
SET $PIECE(LN,"-",132)=""
+5 ;144
IF '$GET(ECXPORT)
DO HEADER
if QFLG
QUIT
+6 SET COUNT=0
SET FKEY=""
+7 FOR
SET FKEY=$ORDER(^TMP($JOB,FKEY))
if FKEY=""!QFLG
QUIT
Begin DoDot:1
+8 SET COST=""
FOR
SET COST=$ORDER(^TMP($JOB,FKEY,COST))
if COST=""!QFLG
QUIT
Begin DoDot:2
+9 SET SDAY=""
FOR
SET SDAY=$ORDER(^TMP($JOB,FKEY,COST,SDAY))
if SDAY=""!QFLG
QUIT
Begin DoDot:3
+10 SET SSN=""
FOR
SET SSN=$ORDER(^TMP($JOB,FKEY,COST,SDAY,SSN))
if SSN=""!QFLG
QUIT
SET REC=^(SSN)
Begin DoDot:4
+11 ;144
IF $GET(ECXPORT)
SET ^TMP($JOB,"ECXPORT",CNT)=REC
SET CNT=CNT+1
QUIT
+12 SET COUNT=COUNT+1
+13 IF $Y+3>IOSL
DO HEADER
if QFLG
QUIT
+14 ;W !,$P(REC,U),?8,$P(REC,U,2),?21,$P(REC,U,3),?39,$P(REC,U,4),?45,$P(REC,U,5),?70,$P(REC,U,6),?93,$$RJ^XLFSTR($P(REC,U,7),8),?110,$$RJ^XLFSTR($P(REC,U,8),11),?127,$P(REC,U,9) ;149,154
+15 ;187 Re-arrange the columns
WRITE !,$PIECE(REC,U),?8,$PIECE(REC,U,2),?19,$PIECE(REC,U,3),?30,$PIECE(REC,U,4),?36,$PIECE(REC,U,5),?58,$PIECE(REC,U,6),?66,$EXTRACT($PIECE(REC,U,7),1,30),?100,$PIECE(REC,U,8)
+16 ;187 re-arrange the columns
WRITE ?103,$PIECE(REC,U,10),?109,$$RJ^XLFSTR($PIECE(REC,U,11),4),?117,$$RJ^XLFSTR($PIECE(REC,U,12),13)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;144
if QFLG!($GET(ECXPORT))
QUIT
+18 IF COUNT=0
WRITE !!,?8,"No unusual costs to report for this extract"
+19 ;154,161 Print key to forms and trans type,187 - Added Unit of Issue
IF COUNT
Begin DoDot:1
+20 ;Make sure there's enough room for the footer info
IF $Y+7>IOSL
DO HEADER
if QFLG
QUIT
+21 WRITE !
DO FOOTER^ECXPROCT
+22 SET SPACE=$$REPEAT^XLFSTR(" ",10)
+23 WRITE !!,"TRAN TYPE:",!,"I:INITIAL ISSUE",SPACE,"R:REPLACE",SPACE,"S:SPARE",SPACE,"X:REPAIR",SPACE,"5:RENTAL"
+24 ;187
WRITE !!,"UNIT OF ISSUE:",!
+25 ;187
SET SPACE=$$REPEAT^XLFSTR(" ",5)
+26 ;187
SET UNIT=""
+27 ;187
FOR
SET UNIT=$ORDER(ECXPROUN(UNIT))
if UNIT=""
QUIT
Begin DoDot:2
+28 WRITE UNIT_":",ECXPROUN(UNIT),SPACE
+29 if $X>120
QUIT
End DoDot:2
+30 QUIT
End DoDot:1
CLOSE ;
+1 IF $EXTRACT(IOST)="C"
IF 'QFLG
Begin DoDot:1
+2 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+3 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
+4 QUIT
+5 ;
+1 NEW SS,JJ
+2 IF $EXTRACT(IOST)="C"
Begin DoDot:1
+3 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+4 IF PG>0
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
if 'Y
SET QFLG=1
End DoDot:1
+5 if QFLG
QUIT
+6 if $Y!($EXTRACT(IOST)="C")
WRITE @IOF
SET PG=PG+1
+7 ;tjl 166 Changed report title
WRITE !,"Prosthetic Pre-Extract Unusual Cost Report",?124,"Page: "_PG
+8 WRITE !,"Start Date: ",ECSTART,?97,"Report Run Date/Time: "_ECRUN
+9 WRITE !," End Date: ",ECEND,?97," Threshold Value: ",ECTHLD
+10 ;W !!,?21,"Date of",?45,"PSAS",?112,"Cost of",?126,"Tran" ;149,154
+11 ;W !,"Name",?11,"SSN",?21,"Service",?39,"FORM",?45,"HCPCS CODE" ;149,154
+12 ;W ?70,"Feeder Key",?93,"Quantity",?110,"Transaction",?126,"Type" ;149
+13 ;187 Re-arrange the columns
WRITE !!,?19,"Date of",?62,"PSAS HCPCS",?98,"Tran",?109,"Unit of",?119,"Cost of"
+14 ;187
WRITE !,"Name",?11,"SSN",?19,"Service",?30,"FORM",?36,"Feeder Key",?58,"CODE Description",?98,"Type"
+15 ;187
WRITE ?104,"QTY",?109,"Issue",?119,"Transaction"
+16 WRITE !,LN,!
+17 QUIT
+18 ;
