source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECXUPRO1.m@ 1008

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1ECXUPRO1 ;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 ;
4EN ; 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 ;
12GETRECS ; 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
37FILE ; 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
54EXIT S ECXERR=1 Q
Note: See TracBrowser for help on using the repository browser.