| 1 | ECXUPRO1 ;ALB/TJL-Prosthetics Extract Unusual Cost Report; 01/08/08 2:49pm
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**49,111**;Jul 2, 2003;Build 4
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; entry point
|
|---|
| 5 | N COUNT,ECDFN,ECD,PROCOST
|
|---|
| 6 | K ^TMP($J)
|
|---|
| 7 | S COUNT=0
|
|---|
| 8 | S ECD=ECSD1,ECED=ECED+.3
|
|---|
| 9 | D GETRECS
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | GETRECS ; get records that are over the threshold
|
|---|
| 13 | N PDA,SUBDA,PROLB,PRO0,PROFORM
|
|---|
| 14 | N DIC,DR,DA,DIQ
|
|---|
| 15 | S QFLG=0,ECXLNE=1,ECXED1=ECED+.9999
|
|---|
| 16 | S PDA=ECSD1
|
|---|
| 17 | F S PDA=$O(^RMPR(660,"CT",PDA)) Q:(PDA>ECXED1)!('PDA)!(QFLG=1) D
|
|---|
| 18 | .S SUBDA=0
|
|---|
| 19 | .F S SUBDA=$O(^RMPR(660,"CT",PDA,SUBDA)) Q:('SUBDA)!(QFLG=1) D
|
|---|
| 20 | ..Q:'$D(^RMPR(660,SUBDA,0))
|
|---|
| 21 | ..S PRO0=^RMPR(660,SUBDA,0)
|
|---|
| 22 | ..S PROLB=$G(^RMPR(660,SUBDA,"LB"))
|
|---|
| 23 | ..K ECXP S DIC="^RMPR(660,",DR=".02;11",DA=SUBDA,DIQ(0)="EI"
|
|---|
| 24 | ..S DIQ="ECXP" D EN^DIQ1
|
|---|
| 25 | ..S ECXDFN=$G(ECXP(660,SUBDA,.02,"I"))
|
|---|
| 26 | ..S PROFORM=$G(ECXP(660,SUBDA,11,"E"))_U_$G(ECXP(660,SUBDA,11,"I"))
|
|---|
| 27 | ..Q:'$$PATDEM^ECXUTL2(ECXDFN,PDA)
|
|---|
| 28 | ..Q:'$$NTEG^ECXPRO1(ECXDFN,.ECXLNE,SUBDA,PRO0,PROLB,ECINST,PROFORM)
|
|---|
| 29 | ..S PROCOST=$P(PRO0,U,16)
|
|---|
| 30 | ..S:PROFORM["-3" PROCOST=$P(PROLB,U,9)
|
|---|
| 31 | ..S:($P(PROFORM,U,2)=11)!($P(PROFORM,U,2)=12) PROCOST=0
|
|---|
| 32 | ..S:PROCOST="" PROCOST=0
|
|---|
| 33 | ..S PROCOST=(PROCOST+.5)\1
|
|---|
| 34 | ..S:PROCOST>999999 PROCOST=999999
|
|---|
| 35 | ..I PROCOST>ECTHLD D FILE
|
|---|
| 36 | Q
|
|---|
| 37 | FILE ; put records in temp file to print later
|
|---|
| 38 | N OK,PROPAT,PRONAME,PROSSN,CPTCODE,ECXFEKEY,PROQTY
|
|---|
| 39 | S OK=$$PAT^ECXUTL3(ECXDFN,$P(ECD,"."),"1;",.PROPAT)
|
|---|
| 40 | I 'OK Q
|
|---|
| 41 | S PRONAME=PROPAT("NAME")
|
|---|
| 42 | S PROSSN=PROPAT("SSN")
|
|---|
| 43 | S PRODAY=$E(PDA,4,5)_"/"_$E(PDA,6,7)_"/"_$E(PDA,2,3)
|
|---|
| 44 | S CPTCODE=$E(ECXHCPCS,1,5)
|
|---|
| 45 | I PROFORM["-3" F ECXLAB="LAB","ORD" D FEEDINFO^ECXPRO2(ECXSRCE,CPTCODE,ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB)
|
|---|
| 46 | I PROFORM'["-3" S ECXLAB="NONL" D FEEDINFO^ECXPRO2(ECXSRCE,CPTCODE,ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB)
|
|---|
| 47 | S PROQTY=$P(PRO0,U,7)
|
|---|
| 48 | S:(+PROQTY=0) PROQTY=1
|
|---|
| 49 | S PROQTY=$$RJ^XLFSTR(PROQTY,8,0)
|
|---|
| 50 | S ^TMP($J,ECXFEKEY,-PROQTY,SUBDA,PROSSN)=PRONAME_U_PROSSN_U_PRODAY_U_ECXHCPCS_U_ECXFEKEY_U_PROQTY_U_"$"_$FNUMBER(PROCOST,",",2)
|
|---|
| 51 | S COUNT=COUNT+1
|
|---|
| 52 | I COUNT#100=0 I $$S^ZTLOAD S (ZSTOP,ECXERR)=1
|
|---|
| 53 | Q
|
|---|
| 54 | EXIT S ECXERR=1 Q
|
|---|
