Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXSCX1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXSCX1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXSCX1.m
r613 r623 1 ECXSCX1 ;ALB/JAP,BIR/DMA-Clinic Extract Message ; 4/11/07 3:26pm 2 ;;3.0;DSS EXTRACTS;**8,28,24,27,29,30,31,33,84,92,105**;Dec 22, 1997;Build 70 3 EN ;entry point from ecxscx 4 N ECX 5 ;send missing clinic message 6 S ECX=$O(^TMP($J,"ECXS","MISS",0)) D 7 .Q:ECX="" 8 .S XMSUB="MISSING CLINICS in File #728.44",XMDUZ="DSS SYSTEM" 9 .K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))="" 10 .F ECX=1:1:5 S ^TMP($J,"ECXS","MISS",ECX,0)=$P($T(MSG+ECX),";;",2) 11 .S XMTEXT="^TMP($J,""ECXS"",""MISS""," D ^XMD 12 ;send no division message 13 S ECX=$O(^TMP($J,"ECXS","DIV",0)) D 14 .Q:ECX="" 15 .S XMSUB="CLINICS w/o DIVISION Data",XMDUZ="DSS SYSTEM" 16 .K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))="" 17 .F ECX=1:1:5 S ^TMP($J,"ECXS","DIV",ECX,0)=$P($T(MSG2+ECX),";;",2) 18 .S XMTEXT="^TMP($J,""ECXS"",""DIV""," D ^XMD 19 ;cleanup 20 K ^TMP($J,"ECXS") 21 Q 22 MSG ;text for missing clinic 23 ;;The following clinics have not been entered into the CLINIC AND 24 ;;STOP CODES file (#728.44). If any listed clinic is currently 25 ;;active, please use the options 'Create DSS Clinic Stop Code File' 26 ;;and 'Enter/Edit DSS Stop Codes for Clinics' to update this file. 27 ;; 28 ; 29 MSG2 ;text for missing division 30 ;;The following clinics in the HOSPITAL LOCATION file (#44) have not 31 ;;been assigned to a division from the MEDICAL CENTER DIVISION file 32 ;;(#40.8). CLI extract records associated with these clinics have 33 ;;been given a default Division identifier of "1". 34 ;; 35 ; 36 MISS ;load ^tmp if clinic missing from #728.44 37 N DAT,ID,RD 38 S (ID,RD)="" 39 S DAT=$G(^SC(SC,"I")) I DAT]"" S ID=+DAT,RD=$P(DAT,U,2) 40 ;ignore inactive clinics 41 I ID,ID<DT I 'RD!(RD>DT) Q 42 I '$D(^TMP($J,"ECXS","ECXMISS")) S ^TMP($J,"ECXS","ECXMISS")=10 43 S ECXMISS=^TMP($J,"ECXS","ECXMISS") 44 S ^TMP($J,"ECXS","MISS",ECXMISS,0)=$J(SC,6)_" "_$$LJ^XLFSTR($P(^SC(SC,0),U),40)_ECSC_"/"_ECCSC 45 S ^TMP($J,"ECXS","ECXMISS")=ECXMISS+1 46 Q 47 ; 48 NODIV ;load ^tmp if clinic w/o division 49 N DAT,ID,RD 50 S (ID,RD)="" 51 S DAT=$G(^SC(SC,"I")) I DAT]"" S ID=+DAT,RD=$P(DAT,U,2) 52 ;ignore inactive clinics 53 I ID,ID<DT I 'RD!(RD>DT) Q 54 I '$D(^TMP($J,"ECXS","ECXMISS")) S ^TMP($J,"ECXS","ECXMISS")=10 55 S ECXMISS=^TMP($J,"ECXS","ECXMISS") 56 S ^TMP($J,"ECXS","DIV",ECXMISS,0)=$J(SC,6)_" "_$$LJ^XLFSTR($P(^SC(SC,0),U),40) 57 S ^TMP($J,"ECXS","ECXMISS")=ECXMISS+1 58 Q 59 ; 60 FEEDER(ECXSC,ECXSD,ECXP1,ECXP2,ECXP3,ECXSEND,ECXDIV) ;get transmission style and feeder key variables 61 ;feeder key = primary stop code_secondary stop code_length of appointment_national clinic code_noshow indicator 62 ; input 63 ; ECXSC = ien of clinic in file #44 (required) 64 ; ECXSD = start date of extract date range (required) 65 ; ECXP1,ECXP2,ECXP3,ECXSEND passed by reference (required) 66 ; output (passed-by-reference variables) 67 ; ECXP1 = primary stop code 68 ; ECXP2 = secondary stop code 69 ; ECXP3 = field #7 of file #728.44 70 ; ECXSEND = field #5 of file #728.44 71 ; ECXDIV = field #3.5 of file #44 72 N ECSC,ECCSC,ECSD1,ECXNC,ECXMISS,CLIN,SC 73 S (ECXP1,ECXP2)="000",ECXP3="0000" 74 S ECXSEND=1,ECXDIV=0 75 Q:+ECXSC=0 76 ;get needed data from ^tmp 77 I $D(^TMP($J,"ECXS","SC",ECXSC)) D 78 .S CLIN=^TMP($J,"ECXS","SC",ECXSC) 79 .S ECXP1=$P(CLIN,U),ECXP2=$P(CLIN,U,2),ECXP3=$P(CLIN,U,3),ECXSEND=$P(CLIN,U,4),ECXDIV=$P(CLIN,U,5) 80 .S ECXDIV=+$P($G(^TMP($J,"ECXCL",ECXSC)),U,4) S:ECXDIV=0 ECXDIV=1 81 ;otherwise, set needed data in ^tmp 82 I '$D(^TMP($J,"ECXS","SC",ECXSC)) D 83 .;get division or send no division msg 84 .S ECXDIV=+$P($G(^TMP($J,"ECXCL",ECXSC)),U,4) 85 .I ECXDIV=0 S SC=ECXSC D NODIV S ECXDIV=1 86 .;get other data from file #44 if no #727.44 record; send missing clinic msg 87 .I '$D(^ECX(728.44,ECXSC,0)) D 88 ..S ECSC=+$P($G(^SC(ECXSC,0)),U,7),ECCSC=+$P(^(0),U,18) 89 ..S SC=ECXSC,ECSD1=ECXSD D MISS 90 ..S:ECSC ECXP1=$P($G(^DIC(40.7,ECSC,0)),U,2),ECXP1=$$RJ^XLFSTR(+ECXP1,3,0) 91 .;otherwise get other data from file #728.44 92 .S EC=$G(^ECX(728.44,ECXSC,0)) D 93 ..Q:EC="" 94 ..S ECXSEND=$P(EC,U,6) 95 ..Q:ECXSEND=6 96 ..S ECSC=+$P(EC,U,4),ECCSC=+$P(EC,U,5) 97 ..I 'ECSC S ECSC=+$P(EC,U,2),ECCSC=+$P(EC,U,3) 98 ..I ECSC S ECXP1=$$RJ^XLFSTR(ECSC,3,0),ECXP2=$$RJ^XLFSTR(ECCSC,3,0) 99 ..;if primary stop not valid, use file #44 record 100 ..I 'ECSC S ECSC=+$P($G(^SC(ECXSC,0)),U,7),ECCSC=+$P($G(^(0)),U,18) I ECSC D 101 ...S ECXP1=+$P($G(^DIC(40.7,ECSC,0)),U,2) 102 ...S:ECCSC ECXP2=+$P($G(^DIC(40.7,ECCSC,0)),U,2) 103 ...S ECXP1=$$RJ^XLFSTR(ECXP1,3,0),ECXP2=$$RJ^XLFSTR(ECXP2,3,0) 104 .;for action code=1, secondary stop code is always "000" 105 .I ECXSEND=1 S ECXP2="000" 106 .;action code of 2 or 3 should not be used, but continue to follow v2t11 logic 107 .I ECXSEND=2 S ECXP1=ECXP2,ECXP2="000" 108 .;for action code=4, need to get national clinic code 109 .I ECXSEND=4 D 110 ..S ECXNC=+$P($G(^ECX(728.44,ECXSC,0)),U,8) 111 ..I ECXNC S ECXNC=$P($G(^ECX(728.441,ECXNC,0)),U),ECXP3=$$RJ^XLFSTR(ECXNC,4,0) 112 .;set data in ^tmp 113 .S ^TMP($J,"ECXS","SC",ECXSC)=ECXP1_U_ECXP2_U_ECXP3_U_ECXSEND 114 Q 115 ; 116 VISIT(ECXDFN,ECXVISIT,ECXVIST,ECXERR) ;get visit specific data 117 ;input ECXVISIT = pointer to file #9000010 118 ; ECXSVC = sc percentage 119 ;output ECXVSIT = data array 120 ; ECXERR = 1 indicates error; otherwise, 0 121 N AO,ARRAY,CM,CNT,CPT,DA,DATE,DA,DIQ,ICD,ICD9,IR,LEN,M,MOD,MST,NUM 122 N PROV,PROVPC,REC,VAL,VISIT,X,Y,PGE 123 S ECXERR=0,VISIT=ECXVISIT 124 S (ECXVIST("AO"),ECXVIST("IR"),ECXVIST("PGE"),ECXVIST("HNC"))="" 125 S (ECXVIST("MST"),ECXVIST("PROV"),ECXVIST("PROV CLASS"))="" 126 S (ECXVIST("PROV NPI"),ECXVIST("SOURCE"))="" 127 F I="P",1,2,3,4 S ECXVIST("ICD9"_I)="" 128 F I=1:1:8 S ECXVIST("CPT"_I)="" 129 D ENCEVENT^PXAPI(VISIT) 130 I $O(^TMP("PXKENC",$J,VISIT,""))']"" K ECXVIST S ECXERR=1 131 Q:ECXERR 132 S DATE=$P($P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0),U,1),".",1) 133 S ECXVIST("SOURCE")=$P($G(^TMP("PXKENC",$J,VISIT,"VST",VISIT,812)),U,3) 134 ;get icd9 codes upto 5; else use 799.9 135 K ARY S ICD("P")=0,ICD("S")=0,(ARY,REC)="" 136 F S REC=$O(^TMP("PXKENC",$J,VISIT,"POV",REC)) Q:REC="" D 137 .S VAL=^TMP("PXKENC",$J,VISIT,"POV",REC,0) Q:'VAL 138 .I $P(VAL,U,12)="P" D 139 ..S:'$D(ARY("P",+VAL)) CNT=ICD("P")+1,ICD("P",CNT)=+VAL,ICD("P")=CNT 140 ..S ARY("P",+VAL)="" 141 .I $P(VAL,U,12)'="P" D 142 ..S:'$D(ARY("S",+VAL)) CNT=ICD("S")+1,ICD("S",CNT)=+VAL,ICD("S")=CNT 143 ..S ARY("S",+VAL)="" 144 S CNT=0,ECXVIST("ICD9P")=$P($G(^ICD9(+$G(ICD("P",1),0),0)),U) 145 F I=2:1 Q:'$D(ICD("P",I)) D Q:CNT>4 146 .S CNT=CNT+1,ECXVIST("ICD9"_CNT)=$P($G(^ICD9(ICD("P",I),0)),U) 147 I CNT<4 F I=1:1:8 Q:'$D(ICD("S",I)) D Q:CNT>4 148 .I '$D(ARY("P",ICD("S",I))) D 149 ..S CNT=CNT+1,ECXVIST("ICD9"_CNT)=$P($G(^ICD9(ICD("S",I),0)),U) 150 ;get first provider designated as primary 151 ;if no primary, then get first physician provider 152 ;if no physician, then get first provider 153 S (PROV,PROVPC)="" 154 I $O(^TMP("PXKENC",$J,VISIT,"PRV",0)) D 155 .S (REC,VAL)=0 D 156 ..F S REC=$O(^TMP("PXKENC",$J,VISIT,"PRV",REC)) Q:('REC)!(VAL) D 157 ...S:($P(^(REC,0),U,4)="P") VAL=+^(0) 158 ...S PROV=VAL,PROVPC=$$PRVCLASS^ECXUTL(PROV,DATE) 159 .I 'VAL S (REC,VAL)=0 D 160 ..F S REC=$O(^TMP("PXKENC",$J,VISIT,"PRV",REC)) Q:('REC)!(VAL) D 161 ...S (PROV,VAL)=+^(REC,0) 162 ...S PROVPC=$$PRVCLASS^ECXUTL(PROV,DATE) Q:PROVPC="" 163 ...S NUM=$E(PROVPC,2,7) S:(NUM<110000)!(NUM>119999) VAL=0,PROVPC="" 164 .I 'VAL D 165 ..S REC=$O(^TMP("PXKENC",$J,VISIT,"PRV",0)) Q:('REC)!(VAL) 166 ..S VAL=+^(REC,0),PROV=VAL,PROVPC=$$PRVCLASS^ECXUTL(PROV,DATE) 167 .S:PROV]"" PROV="2"_PROV 168 S ECXVIST("PROV")=PROV,ECXVIST("PROV CLASS")=PROVPC 169 S ECXVIST("PROV NPI")="" 170 ;get cpt codes upto 8 & modifiers upto 5 171 S CNT=1,PROV=$E(PROV,2,99) 172 D:$O(^TMP("PXKENC",$J,VISIT,"CPT",0)) 173 .S REC=0 D:PROV]"" 174 ..F S REC=$O(^TMP("PXKENC",$J,VISIT,"CPT",REC)) Q:'REC D Q:CNT>8 175 ...S CPT="",NODE=$G(^TMP("PXKENC",$J,VISIT,"CPT",REC,12)) 176 ...Q:NODE="" 177 ...S NOD1=$S($P(NODE,U,4)=PROV:^TMP("PXKENC",$J,VISIT,"CPT",REC,0),1:"") 178 ...Q:$P(NOD1,U)="" 179 ...S Q="00"_+$P(NOD1,U,16),Q=$S(+Q:$E(Q,$L(Q)-1,$L(Q)),1:"01") 180 ...S CPT=$P(NOD1,U),M=0,MOD="" 181 ...F I=1:1:5 S M=$O(^TMP("PXKENC",$J,VISIT,"CPT",REC,1,M)) Q:'M D 182 ....S MOD=MOD_$S(MOD'="":";",1:"") 183 ....S MOD=MOD_$P(^TMP("PXKENC",$J,VISIT,"CPT",REC,1,M,0),U) 184 ...S ECXVIST("CPT"_CNT)=$$CPT^ECXUTL3(CPT,MOD,Q),CNT=CNT+1 185 ...K ^TMP("PXKENC",$J,VISIT,"CPT",REC) 186 ..Q:CNT>8 187 .Q:CNT>8 S REC=0 188 .F S REC=$O(^TMP("PXKENC",$J,VISIT,"CPT",REC)) Q:'REC D Q:CNT>8 189 ..S CPT="",NOD1=$G(^TMP("PXKENC",$J,VISIT,"CPT",REC,0)) 190 ..Q:$P(NOD1,U)="" 191 ..S Q="00"_+$P(NOD1,U,16),Q=$S(+Q:$E(Q,$L(Q)-1,$L(Q)),1:"01") 192 ..S CPT=$P(NOD1,U),M=0,MOD="" 193 ..F I=1:1:5 S M=$O(^TMP("PXKENC",$J,VISIT,"CPT",REC,1,M)) Q:'M D 194 ...S MOD=MOD_$S(MOD'="":";",1:"") 195 ...S MOD=MOD_$P(^TMP("PXKENC",$J,VISIT,"CPT",REC,1,M,0),U) 196 ..S ECXVIST("CPT"_CNT)=$$CPT^ECXUTL3(CPT,MOD,Q),CNT=CNT+1 197 ..K ^TMP("PXKENC",$J,VISIT,"CPT",REC) 198 ..Q:CNT>8 199 S:ECXVIST("CPT1")="" ECXVIST("CPT1")=9919901 200 ;ao, ir, mst, pge, hnc 201 S (AO,IR,MST,PGE,HNC)="" 202 I $D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800)) D 203 .S AO=$P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800),U,2) 204 .S IR=$P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800),U,3),MST=$P(^(800),U,5) 205 .S PGE=$P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800),U,4),HNC=$P(^(800),U,6) 206 .S ECXVIST("AO")=$S(AO=0:"N",AO=1:"Y",1:"") 207 .S ECXVIST("IR")=$S(IR=0:"N",IR=1:"Y",1:"") 208 .S ECXVIST("MST")=$S(MST=0:"N",MST=1:"Y",1:"") 209 .S ECXVIST("PGE")=$S(PGE=0:"N",PGE=1:"Y",1:"") 210 .S ECXVIST("HNC")=$S(HNC=0:"N",HNC=1:"Y",1:"") 211 Q 1 ECXSCX1 ;ALB/JAP,BIR/DMA-Clinic Extract Message ; 8/17/06 7:59am 2 ;;3.0;DSS EXTRACTS;**8,28,24,27,29,30,31,33,84,92**;Dec 22, 1997;Build 30 3 EN ;entry point from ecxscx 4 N ECX 5 ;send missing clinic message 6 S ECX=$O(^TMP($J,"ECXS","MISS",0)) D 7 .Q:ECX="" 8 .S XMSUB="MISSING CLINICS in File #728.44",XMDUZ="DSS SYSTEM" 9 .K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))="" 10 .F ECX=1:1:5 S ^TMP($J,"ECXS","MISS",ECX,0)=$P($T(MSG+ECX),";;",2) 11 .S XMTEXT="^TMP($J,""ECXS"",""MISS""," D ^XMD 12 ;send no division message 13 S ECX=$O(^TMP($J,"ECXS","DIV",0)) D 14 .Q:ECX="" 15 .S XMSUB="CLINICS w/o DIVISION Data",XMDUZ="DSS SYSTEM" 16 .K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))="" 17 .F ECX=1:1:5 S ^TMP($J,"ECXS","DIV",ECX,0)=$P($T(MSG2+ECX),";;",2) 18 .S XMTEXT="^TMP($J,""ECXS"",""DIV""," D ^XMD 19 ;cleanup 20 K ^TMP($J,"ECXS") 21 Q 22 MSG ;text for missing clinic 23 ;;The following clinics have not been entered into the CLINIC AND 24 ;;STOP CODES file (#728.44). If any listed clinic is currently 25 ;;active, please use the options 'Create DSS Clinic Stop Code File' 26 ;;and 'Enter/Edit DSS Stop Codes for Clinics' to update this file. 27 ;; 28 ; 29 MSG2 ;text for missing division 30 ;;The following clinics in the HOSPITAL LOCATION file (#44) have not 31 ;;been assigned to a division from the MEDICAL CENTER DIVISION file 32 ;;(#40.8). CLI extract records associated with these clinics have 33 ;;been given a default Division identifier of "1". 34 ;; 35 ; 36 MISS ;load ^tmp if clinic missing from #728.44 37 N DAT,ID,RD 38 S (ID,RD)="" 39 S DAT=$G(^SC(SC,"I")) I DAT]"" S ID=+DAT,RD=$P(DAT,U,2) 40 ;ignore inactive clinics 41 I ID,ID<DT I 'RD!(RD>DT) Q 42 I '$D(^TMP($J,"ECXS","ECXMISS")) S ^TMP($J,"ECXS","ECXMISS")=10 43 S ECXMISS=^TMP($J,"ECXS","ECXMISS") 44 S ^TMP($J,"ECXS","MISS",ECXMISS,0)=$J(SC,6)_" "_$$LJ^XLFSTR($P(^SC(SC,0),U),40)_ECSC_"/"_ECCSC 45 S ^TMP($J,"ECXS","ECXMISS")=ECXMISS+1 46 Q 47 ; 48 NODIV ;load ^tmp if clinic w/o division 49 N DAT,ID,RD 50 S (ID,RD)="" 51 S DAT=$G(^SC(SC,"I")) I DAT]"" S ID=+DAT,RD=$P(DAT,U,2) 52 ;ignore inactive clinics 53 I ID,ID<DT I 'RD!(RD>DT) Q 54 I '$D(^TMP($J,"ECXS","ECXMISS")) S ^TMP($J,"ECXS","ECXMISS")=10 55 S ECXMISS=^TMP($J,"ECXS","ECXMISS") 56 S ^TMP($J,"ECXS","DIV",ECXMISS,0)=$J(SC,6)_" "_$$LJ^XLFSTR($P(^SC(SC,0),U),40) 57 S ^TMP($J,"ECXS","ECXMISS")=ECXMISS+1 58 Q 59 ; 60 FEEDER(ECXSC,ECXSD,ECXP1,ECXP2,ECXP3,ECXSEND,ECXDIV) ;get transmission style and feeder key variables 61 ;feeder key = primary stop code_secondary stop code_length of appointment_national clinic code_noshow indicator 62 ; input 63 ; ECXSC = ien of clinic in file #44 (required) 64 ; ECXSD = start date of extract date range (required) 65 ; ECXP1,ECXP2,ECXP3,ECXSEND passed by reference (required) 66 ; output (passed-by-reference variables) 67 ; ECXP1 = primary stop code 68 ; ECXP2 = secondary stop code 69 ; ECXP3 = field #7 of file #728.44 70 ; ECXSEND = field #5 of file #728.44 71 ; ECXDIV = field #3.5 of file #44 72 N ECSC,ECCSC,ECSD1,ECXNC,ECXMISS,CLIN,SC 73 S (ECXP1,ECXP2)="000",ECXP3="0000" 74 S ECXSEND=1,ECXDIV=0 75 Q:+ECXSC=0 76 ;get needed data from ^tmp 77 I $D(^TMP($J,"ECXS","SC",ECXSC)) D 78 .S CLIN=^TMP($J,"ECXS","SC",ECXSC) 79 .S ECXP1=$P(CLIN,U),ECXP2=$P(CLIN,U,2),ECXP3=$P(CLIN,U,3),ECXSEND=$P(CLIN,U,4),ECXDIV=$P(CLIN,U,5) 80 .S ECXDIV=+$P($G(^TMP($J,"ECXCL",ECXSC)),U,4) S:ECXDIV=0 ECXDIV=1 81 ;otherwise, set needed data in ^tmp 82 I '$D(^TMP($J,"ECXS","SC",ECXSC)) D 83 .;get division or send no division msg 84 .S ECXDIV=+$P($G(^TMP($J,"ECXCL",ECXSC)),U,4) 85 .I ECXDIV=0 S SC=ECXSC D NODIV S ECXDIV=1 86 .;get other data from file #44 if no #727.44 record; send missing clinic msg 87 .I '$D(^ECX(728.44,ECXSC,0)) D 88 ..S ECSC=+$P($G(^SC(ECXSC,0)),U,7),ECCSC=+$P(^(0),U,18) 89 ..S SC=ECXSC,ECSD1=ECXSD D MISS 90 ..S:ECSC ECXP1=$P($G(^DIC(40.7,ECSC,0)),U,2),ECXP1=$$RJ^XLFSTR(+ECXP1,3,0) 91 .;otherwise get other data from file #728.44 92 .S EC=$G(^ECX(728.44,ECXSC,0)) D 93 ..Q:EC="" 94 ..S ECXSEND=$P(EC,U,6) 95 ..Q:ECXSEND=6 96 ..S ECSC=+$P(EC,U,4),ECCSC=+$P(EC,U,5) 97 ..I 'ECSC S ECSC=+$P(EC,U,2),ECCSC=+$P(EC,U,3) 98 ..I ECSC S ECXP1=$$RJ^XLFSTR(ECSC,3,0),ECXP2=$$RJ^XLFSTR(ECCSC,3,0) 99 ..;if primary stop not valid, use file #44 record 100 ..I 'ECSC S ECSC=+$P($G(^SC(ECXSC,0)),U,7),ECCSC=+$P($G(^(0)),U,18) I ECSC D 101 ...S ECXP1=+$P($G(^DIC(40.7,ECSC,0)),U,2) 102 ...S:ECCSC ECXP2=+$P($G(^DIC(40.7,ECCSC,0)),U,2) 103 ...S ECXP1=$$RJ^XLFSTR(ECXP1,3,0),ECXP2=$$RJ^XLFSTR(ECXP2,3,0) 104 .;for action code=1, secondary stop code is always "000" 105 .I ECXSEND=1 S ECXP2="000" 106 .;action code of 2 or 3 should not be used, but continue to follow v2t11 logic 107 .I ECXSEND=2 S ECXP1=ECXP2,ECXP2="000" 108 .;for action code=4, need to get national clinic code 109 .I ECXSEND=4 D 110 ..S ECXNC=+$P($G(^ECX(728.44,ECXSC,0)),U,8) 111 ..I ECXNC S ECXNC=$P($G(^ECX(728.441,ECXNC,0)),U),ECXP3=$$RJ^XLFSTR(ECXNC,4,0) 112 .;set data in ^tmp 113 .S ^TMP($J,"ECXS","SC",ECXSC)=ECXP1_U_ECXP2_U_ECXP3_U_ECXSEND 114 Q 115 ; 116 VISIT(ECXDFN,ECXVISIT,ECXVIST,ECXERR) ;get visit specific data 117 ;input ECXVISIT = pointer to file #9000010 118 ; ECXSVC = sc percentage 119 ;output ECXVSIT = data array 120 ; ECXERR = 1 indicates error; otherwise, 0 121 N AO,ARRAY,CM,CNT,CPT,DA,DATE,DA,DIQ,ICD,ICD9,IR,LEN,M,MOD,MST,NUM 122 N PROV,PROVPC,REC,VAL,VISIT,X,Y,PGE 123 S ECXERR=0,VISIT=ECXVISIT 124 S (ECXVIST("AO"),ECXVIST("IR"),ECXVIST("PGE"),ECXVIST("HNC"))="" 125 S (ECXVIST("MST"),ECXVIST("PROV"),ECXVIST("PROV CLASS"))="" 126 S (ECXVIST("PROV NPI"),ECXVIST("SOURCE"))="" 127 F I="P",1,2,3,4 S ECXVIST("ICD9"_I)="" 128 F I=1:1:8 S ECXVIST("CPT"_I)="" 129 D ENCEVENT^PXAPI(VISIT) 130 I $O(^TMP("PXKENC",$J,VISIT,""))']"" K ECXVIST S ECXERR=1 131 Q:ECXERR 132 S DATE=$P($P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0),U,1),".",1) 133 S ECXVIST("SOURCE")=$P($G(^TMP("PXKENC",$J,VISIT,"VST",VISIT,812)),U,3) 134 ;get icd9 codes upto 5; else use 799.9 135 K ARY S ICD("P")=0,ICD("S")=0,(ARY,REC)="" 136 F S REC=$O(^TMP("PXKENC",$J,VISIT,"POV",REC)) Q:REC="" D 137 .S VAL=^TMP("PXKENC",$J,VISIT,"POV",REC,0) Q:'VAL 138 .I $P(VAL,U,12)="P" D 139 ..S:'$D(ARY("P",+VAL)) CNT=ICD("P")+1,ICD("P",CNT)=+VAL,ICD("P")=CNT 140 ..S ARY("P",+VAL)="" 141 .I $P(VAL,U,12)'="P" D 142 ..S:'$D(ARY("S",+VAL)) CNT=ICD("S")+1,ICD("S",CNT)=+VAL,ICD("S")=CNT 143 ..S ARY("S",+VAL)="" 144 S CNT=0,ECXVIST("ICD9P")=$P($G(^ICD9(+$G(ICD("P",1),0),0)),U) 145 F I=2:1 Q:'$D(ICD("P",I)) D Q:CNT>4 146 .S CNT=CNT+1,ECXVIST("ICD9"_CNT)=$P($G(^ICD9(ICD("P",I),0)),U) 147 I CNT<4 F I=1:1:8 Q:'$D(ICD("S",I)) D Q:CNT>4 148 .I '$D(ARY("P",ICD("S",I))) D 149 ..S CNT=CNT+1,ECXVIST("ICD9"_CNT)=$P($G(^ICD9(ICD("S",I),0)),U) 150 S:(ECXVIST("ICD9P")="")&(ECXVIST("ICD91")="") ECXVIST("ICD9P")="799.9" 151 ;get first provider designated as primary 152 ;if no primary, then get first physician provider 153 ;if no physician, then get first provider 154 S (PROV,PROVPC)="" 155 I $O(^TMP("PXKENC",$J,VISIT,"PRV",0)) D 156 .S (REC,VAL)=0 D 157 ..F S REC=$O(^TMP("PXKENC",$J,VISIT,"PRV",REC)) Q:('REC)!(VAL) D 158 ...S:($P(^(REC,0),U,4)="P") VAL=+^(0) 159 ...S PROV=VAL,PROVPC=$$PRVCLASS^ECXUTL(PROV,DATE) 160 .I 'VAL S (REC,VAL)=0 D 161 ..F S REC=$O(^TMP("PXKENC",$J,VISIT,"PRV",REC)) Q:('REC)!(VAL) D 162 ...S (PROV,VAL)=+^(REC,0) 163 ...S PROVPC=$$PRVCLASS^ECXUTL(PROV,DATE) Q:PROVPC="" 164 ...S NUM=$E(PROVPC,2,7) S:(NUM<110000)!(NUM>119999) VAL=0,PROVPC="" 165 .I 'VAL D 166 ..S REC=$O(^TMP("PXKENC",$J,VISIT,"PRV",0)) Q:('REC)!(VAL) 167 ..S VAL=+^(REC,0),PROV=VAL,PROVPC=$$PRVCLASS^ECXUTL(PROV,DATE) 168 .S:PROV]"" PROV="2"_PROV 169 S ECXVIST("PROV")=PROV,ECXVIST("PROV CLASS")=PROVPC 170 S ECXVIST("PROV NPI")="" 171 ;get cpt codes upto 8 & modifiers upto 5 172 S CNT=1,PROV=$E(PROV,2,99) 173 D:$O(^TMP("PXKENC",$J,VISIT,"CPT",0)) 174 .S REC=0 D:PROV]"" 175 ..F S REC=$O(^TMP("PXKENC",$J,VISIT,"CPT",REC)) Q:'REC D Q:CNT>8 176 ...S CPT="",NODE=$G(^TMP("PXKENC",$J,VISIT,"CPT",REC,12)) 177 ...Q:NODE="" 178 ...S NOD1=$S($P(NODE,U,4)=PROV:^TMP("PXKENC",$J,VISIT,"CPT",REC,0),1:"") 179 ...Q:$P(NOD1,U)="" 180 ...S Q="00"_+$P(NOD1,U,16),Q=$S(+Q:$E(Q,$L(Q)-1,$L(Q)),1:"01") 181 ...S CPT=$P(NOD1,U),M=0,MOD="" 182 ...F I=1:1:5 S M=$O(^TMP("PXKENC",$J,VISIT,"CPT",REC,1,M)) Q:'M D 183 ....S MOD=MOD_$S(MOD'="":";",1:"") 184 ....S MOD=MOD_$P(^TMP("PXKENC",$J,VISIT,"CPT",REC,1,M,0),U) 185 ...S ECXVIST("CPT"_CNT)=$$CPT^ECXUTL3(CPT,MOD,Q),CNT=CNT+1 186 ...K ^TMP("PXKENC",$J,VISIT,"CPT",REC) 187 ..Q:CNT>8 188 .Q:CNT>8 S REC=0 189 .F S REC=$O(^TMP("PXKENC",$J,VISIT,"CPT",REC)) Q:'REC D Q:CNT>8 190 ..S CPT="",NOD1=$G(^TMP("PXKENC",$J,VISIT,"CPT",REC,0)) 191 ..Q:$P(NOD1,U)="" 192 ..S Q="00"_+$P(NOD1,U,16),Q=$S(+Q:$E(Q,$L(Q)-1,$L(Q)),1:"01") 193 ..S CPT=$P(NOD1,U),M=0,MOD="" 194 ..F I=1:1:5 S M=$O(^TMP("PXKENC",$J,VISIT,"CPT",REC,1,M)) Q:'M D 195 ...S MOD=MOD_$S(MOD'="":";",1:"") 196 ...S MOD=MOD_$P(^TMP("PXKENC",$J,VISIT,"CPT",REC,1,M,0),U) 197 ..S ECXVIST("CPT"_CNT)=$$CPT^ECXUTL3(CPT,MOD,Q),CNT=CNT+1 198 ..K ^TMP("PXKENC",$J,VISIT,"CPT",REC) 199 ..Q:CNT>8 200 S:ECXVIST("CPT1")="" ECXVIST("CPT1")=9919901 201 ;ao, ir, mst, pge, hnc 202 S (AO,IR,MST,PGE,HNC)="" 203 I $D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800)) D 204 .S AO=$P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800),U,2) 205 .S IR=$P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800),U,3),MST=$P(^(800),U,5) 206 .S PGE=$P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800),U,4),HNC=$P(^(800),U,6) 207 .S ECXVIST("AO")=$S(AO=0:"N",AO=1:"Y",1:"") 208 .S ECXVIST("IR")=$S(IR=0:"N",IR=1:"Y",1:"") 209 .S ECXVIST("MST")=$S(MST=0:"N",MST=1:"Y",1:"") 210 .S ECXVIST("PGE")=$S(PGE=0:"N",PGE=1:"Y",1:"") 211 .S ECXVIST("HNC")=$S(HNC=0:"N",HNC=1:"Y",1:"") 212 Q
Note:
See TracChangeset
for help on using the changeset viewer.
