ECXSCX1 ;ALB/JAP,BIR/DMA-Clinic Extract Message ;2/25/19 11:55
;;3.0;DSS EXTRACTS;**8,28,24,27,29,30,31,33,84,92,105,127,132,144,149,154,166,170,174,184**;Dec 22, 1997;Build 124
EN ;entry point from ecxscx
N ECX
;send missing clinic message
S ECX=$O(^TMP($J,"ECXS","MISS",0)) D
.Q:ECX=""
.S XMSUB="MISSING CLINICS in File #728.44",XMDUZ="DSS SYSTEM"
.K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
.F ECX=1:1:8 S ^TMP($J,"ECXS","MISS",ECX,0)=$P($T(MSG+ECX),";;",2) ;174 Add more lines to text
.S XMTEXT="^TMP($J,""ECXS"",""MISS""," D ^XMD
;send no division message
S ECX=$O(^TMP($J,"ECXS","DIV",0)) D
.Q:ECX=""
.S XMSUB="CLINICS w/o DIVISION Data",XMDUZ="DSS SYSTEM"
.K XMY S XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
.F ECX=1:1:5 S ^TMP($J,"ECXS","DIV",ECX,0)=$P($T(MSG2+ECX),";;",2)
.S XMTEXT="^TMP($J,""ECXS"",""DIV""," D ^XMD
;cleanup
K ^TMP($J,"ECXS")
Q
MSG ;text for missing clinic
;;The following clinics have not been entered into the CLINIC AND
;;STOP CODES file (#728.44). If any listed clinic is currently
;;active, please use the options 'Create DSS Clinic Stop Code File'
;;and 'Enter/Edit DSS Stop Codes for Clinics' to update this file.
;;
;;CLIN IEN CLINIC NAME STOP/CREDIT STOP
;;----------------------------------------------------------
;;
;
MSG2 ;text for missing division
;;The following clinics in the HOSPITAL LOCATION file (#44) have not
;;been assigned to a division from the MEDICAL CENTER DIVISION file
;;(#40.8). CLI extract records associated with these clinics have
;;been given a default Division identifier of "1".
;;
;
MISS ;load ^tmp if clinic missing from #728.44
N DAT,ID,RD
S (ID,RD)=""
S DAT=$G(^SC(SC,"I")) I DAT]"" S ID=+DAT,RD=$P(DAT,U,2)
;ignore inactive clinics
I ID,ID<DT I 'RD!(RD>DT) Q
I '$D(^TMP($J,"ECXS","ECXMISS")) S ^TMP($J,"ECXS","ECXMISS")=10
S ECXMISS=^TMP($J,"ECXS","ECXMISS")
S ^TMP($J,"ECXS","MISS",ECXMISS,0)=$J(SC,8)_" "_$$LJ^XLFSTR($P(^SC(SC,0),U),32)_$S(ECSC:$$GET1^DIQ(40.7,ECSC_",",1),1:"")_"/"_$S(ECCSC:$$GET1^DIQ(40.7,ECCSC_",",1),1:"") ;174 Report codes instead of IENs
S ^TMP($J,"ECXS","ECXMISS")=ECXMISS+1
Q
;
NODIV ;load ^tmp if clinic w/o division
N DAT,ID,RD
S (ID,RD)=""
S DAT=$G(^SC(SC,"I")) I DAT]"" S ID=+DAT,RD=$P(DAT,U,2)
;ignore inactive clinics
I ID,ID<DT I 'RD!(RD>DT) Q
I '$D(^TMP($J,"ECXS","ECXMISS")) S ^TMP($J,"ECXS","ECXMISS")=10
S ECXMISS=^TMP($J,"ECXS","ECXMISS")
S ^TMP($J,"ECXS","DIV",ECXMISS,0)=$J(SC,6)_" "_$$LJ^XLFSTR($P(^SC(SC,0),U),40)
S ^TMP($J,"ECXS","ECXMISS")=ECXMISS+1
Q
;
FEEDER(ECXSC,ECXSD,ECXP1,ECXP2,ECXP3,ECXSEND,ECXDIV,ECXP4) ;166 - get transmission style and feeder key variables. New parameter added for labor code
;feeder key = primary stop code_secondary stop code_length of appointment_national clinic code_noshow indicator_labor code
; input
; ECXSC = ien of clinic in file #44 (required)
; ECXSD = start date of extract date range (required)
; ECXP1,ECXP2,ECXP3,ECXP4,ECXSEND passed by reference (required)
; output (passed-by-reference variables)
; ECXP1 = primary stop code
; ECXP2 = secondary stop code
; ECXP3 = field #7 of file #728.44
; ECXP4 = field #13 of file #728.44
; ECXSEND = field #5 of file #728.44
; ECXDIV = field #3.5 of file #44
N ECSC,ECCSC,ECSD1,ECXNC,ECXMISS,CLIN,SC,ECXMLC ;166
S (ECXP1,ECXP2)="000",ECXP3="0000",ECXP4="" ;166
S ECXSEND=1,ECXDIV=0
Q:+ECXSC=0
;get needed data from ^tmp
I $D(^TMP($J,"ECXS","SC",ECXSC)) D
.S CLIN=^TMP($J,"ECXS","SC",ECXSC)
.S ECXP1=$P(CLIN,U),ECXP2=$P(CLIN,U,2),ECXP3=$P(CLIN,U,3),ECXSEND=$P(CLIN,U,4),ECXP4=$P(CLIN,U,5) ;166
.S ECXDIV=+$P($G(^TMP($J,"ECXCL",ECXSC)),U,4) S:ECXDIV=0 ECXDIV=1
;otherwise, set needed data in ^tmp
I '$D(^TMP($J,"ECXS","SC",ECXSC)) D
.;get division or send no division msg
.S ECXDIV=+$P($G(^TMP($J,"ECXCL",ECXSC)),U,4)
.I ECXDIV=0 S SC=ECXSC D NODIV S ECXDIV=1
.;get other data from file #44 if no #728.44 record; send missing clinic msg
.I '$D(^ECX(728.44,ECXSC,0)) D
..S ECSC=+$P($G(^SC(ECXSC,0)),U,7),ECCSC=+$P(^(0),U,18)
..S SC=ECXSC,ECSD1=ECXSD D MISS
..S:ECSC ECXP1=$P($G(^DIC(40.7,ECSC,0)),U,2),ECXP1=$$RJ^XLFSTR(+ECXP1,3,0)
.;otherwise get other data from file #728.44
.S EC=$G(^ECX(728.44,ECXSC,0)) D
..Q:EC=""
..S ECXSEND=$P(EC,U,6)
..Q:ECXSEND=6
..S ECSC=+$P(EC,U,4),ECCSC=+$P(EC,U,5)
..I 'ECSC S ECSC=+$P(EC,U,2),ECCSC=+$P(EC,U,3)
..I ECSC S ECXP1=$$RJ^XLFSTR(ECSC,3,0),ECXP2=$$RJ^XLFSTR(ECCSC,3,0)
..;if primary stop not valid, use file #44 record
..I 'ECSC S ECSC=+$P($G(^SC(ECXSC,0)),U,7),ECCSC=+$P($G(^(0)),U,18) I ECSC D
...S ECXP1=+$P($G(^DIC(40.7,ECSC,0)),U,2)
...S:ECCSC ECXP2=+$P($G(^DIC(40.7,ECCSC,0)),U,2)
...S ECXP1=$$RJ^XLFSTR(ECXP1,3,0),ECXP2=$$RJ^XLFSTR(ECXP2,3,0)
.;for action code=1, secondary stop code is always "000"
.I ECXSEND=1 S ECXP2="000"
.;action code of 2 or 3 should not be used, but continue to follow v2t11 logic
.I ECXSEND=2 S ECXP1=ECXP2,ECXP2="000"
.;for action code=4, need to get national clinic code
.I ECXSEND=4 D
..S ECXNC=+$P($G(^ECX(728.44,ECXSC,0)),U,8)
..I ECXNC S ECXNC=$P($G(^ECX(728.441,ECXNC,0)),U),ECXP3=$$RJ^XLFSTR(ECXNC,4,0)
.;set data in ^tmp
.S ECXMLC=$S($G(ECXLOGIC)>2017:$$GET1^DIQ(728.44,ECXSC,13),1:"") ;166 Get labor code from 728.44 but only use it if it's FY18 or later
.S ^TMP($J,"ECXS","SC",ECXSC)=ECXP1_U_ECXP2_U_ECXP3_U_ECXSEND_U_ECXMLC ;166 Add MCAO Labor Code
Q
;
VISIT(ECXDFN,ECXVISIT,ECXVIST,ECXERR) ;get visit specific data
;input ECXVISIT = pointer to file #9000010
; ECXSVC = sc percentage
;output ECXVSIT = data array
; ECXERR = 1 indicates error; otherwise, 0
N AO,ARRAY,CM,CNT,CPT,DA,DATE,DA,DIQ,ICD,ICD9,IR,LEN,M,MOD,MST,NUM,NOD1,NODE
N PROV,PROVPC,REC,VAL,VISIT,X,Y,HNC,PGE,CV,SHAD,ENCSC,ENCCL ;144
N MAXCPT,MAXMOD ;170
N PROVX12 ;184
S MAXCPT=8 S:ECXLOGIC>2018 MAXCPT=25 ;170
S MAXMOD=5 S:ECXLOGIC>2018 MAXMOD=6 ;170
S ECXERR=0,VISIT=ECXVISIT
S (ECXVIST("AO"),ECXVIST("IR"),ECXVIST("PGE"),ECXVIST("HNC"))=""
S (ECXVIST("MST"),ECXVIST("CV"),ECXVIST("SHAD"),ECXVIST("ENCSC"),ECXVIST("ENCCL"))="" ;144
;MRY-2/4/2010, extracts don't seem to use encounter (visit) "CV".
;extracts use eligibility API for some reason. Added "CV" anyway.
S (ECXVIST("PROV"),ECXVIST("PROV CLASS"))=""
S (ECXVIST("PROV NPI"),ECXVIST("SOURCE"))=""
S ECXVIST("PROV X12")="" ;184
F I="P",1,2,3,4 S ECXVIST("ICD9"_I)=""
F I=1:1:MAXCPT S ECXVIST("CPT"_I)=""
D ENCEVENT^PXAPI(VISIT)
I $O(^TMP("PXKENC",$J,VISIT,""))']"" K ECXVIST S ECXERR=1
Q:ECXERR
S DATE=$P($P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0),U,1),".",1)
S ECXVIST("SOURCE")=$P($G(^TMP("PXKENC",$J,VISIT,"VST",VISIT,812)),U,3)
;get icd codes upto 5, will be stored in ICD9 named variables, even if they're 10 codes (or any future version)
K ARY S ICD("P")=0,ICD("S")=0,(ARY,REC)=""
F S REC=$O(^TMP("PXKENC",$J,VISIT,"POV",REC)) Q:REC="" D
.S VAL=^TMP("PXKENC",$J,VISIT,"POV",REC,0) Q:'VAL
.I $P(VAL,U,12)="P" D
..S:'$D(ARY("P",+VAL)) CNT=ICD("P")+1,ICD("P",CNT)=+VAL,ICD("P")=CNT
..S ARY("P",+VAL)=""
.I $P(VAL,U,12)'="P" D
..S:'$D(ARY("S",+VAL)) CNT=ICD("S")+1,ICD("S",CNT)=+VAL,ICD("S")=CNT
..S ARY("S",+VAL)=""
S CNT=0,ECXVIST("ICD9P")=$S(+$G(ICD("P",1)):$$CODEC^ICDEX(80,ICD("P",1)),1:"") ;154 Get code if value exists in ICD("P",1) else return null
F I=2:1 Q:'$D(ICD("P",I)) D Q:CNT>4
.S CNT=CNT+1,ECXVIST("ICD9"_CNT)=$S(+$G(ICD("P",I)):$$CODEC^ICDEX(80,ICD("P",I)),1:"") ;154 Get code if value exists in ICD("P",I) else return null
I CNT<4 F I=1:1:8 Q:'$D(ICD("S",I)) D Q:CNT>4
.I '$D(ARY("P",ICD("S",I))) D
..S CNT=CNT+1,ECXVIST("ICD9"_CNT)=$S(+$G(ICD("S",I)):$$CODEC^ICDEX(80,ICD("S",I)),1:"") ;154 Get code if value exists in ICD("S",I) else return null
;get first provider designated as primary
;if no primary, then get first physician provider
;if no physician, then get first provider
S (PROV,PROVPC)=""
S PROVX12="" ;184 - Provider Taxonomy (X12 Code)
I $O(^TMP("PXKENC",$J,VISIT,"PRV",0)) D
.S (REC,VAL)=0 D
..F S REC=$O(^TMP("PXKENC",$J,VISIT,"PRV",REC)) Q:('REC)!(VAL) D
...S:($P(^(REC,0),U,4)="P") VAL=+^(0)
...S PROV=VAL,PROVPC=$$PRVCLASS^ECXUTL(PROV,DATE)
...S PROVX12=$$PRVX12^ECXUTL(PROV,DATE) ;184 - Provider Taxonomy
.I 'VAL S (REC,VAL)=0 D
..F S REC=$O(^TMP("PXKENC",$J,VISIT,"PRV",REC)) Q:('REC)!(VAL) D
...S (PROV,VAL)=+^(REC,0)
...S PROVPC=$$PRVCLASS^ECXUTL(PROV,DATE) Q:PROVPC=""
...S PROVX12=$$PRVX12^ECXUTL(PROV,DATE) ;184 - Provider Taxonomy
...S NUM=$E(PROVPC,2,7) S:(NUM<110000)!(NUM>119999) VAL=0,PROVPC=""
.I 'VAL D
..S REC=$O(^TMP("PXKENC",$J,VISIT,"PRV",0)) Q:('REC)!(VAL)
..S VAL=+^(REC,0),PROV=VAL,PROVPC=$$PRVCLASS^ECXUTL(PROV,DATE)
..S PROVX12=$$PRVX12^ECXUTL(PROV,DATE) ;184 - Provider Taxonomy
.S:PROV]"" PROV="2"_PROV
S ECXVIST("PROV")=PROV,ECXVIST("PROV CLASS")=PROVPC
S ECXVIST("PROV NPI")=""
S ECXVIST("PROV X12")=PROVX12 ;184
;get 1-7 secondary physicians
F I=1:1:7 S ECXVIST("PROVS"_I)="" ;144 two more providers cvw
I $O(^TMP("PXKENC",$J,VISIT,"PRV",0)) D
.S (REC,VAL,COUNTS)=0 D
..F S REC=$O(^TMP("PXKENC",$J,VISIT,"PRV",REC)) Q:('REC) D
...Q:$P(^(REC,0),U,4)'="S"
...S VAL=+^(0) I $E(PROV,2,99)=VAL Q ;don't process, primary
...S COUNTS=COUNTS+1 Q:(COUNTS>7) ;144 two more providers cvw
...S PROVS=VAL,PROVSPC=$$PRVCLASS^ECXUTL(PROVS,DATE)
...S PROVSNPI=$$NPI^XUSNPI("Individual_ID",PROVS,DATE)
...S:+PROVSNPI'>0 PROVSNPI="" S PROVSNPI=$P(PROVSNPI,U)
...S ECXVIST("PROVS"_COUNTS)="2"_PROVS_U_PROVSPC_U_PROVSNPI
;get cpt codes up to MAXCPT & modifiers up to MAXMOD
S CNT=1,PROV=$E(PROV,2,99)
S ECXVIST("PRIMPROC")="" ;149 Initialize primary procedure
D:$O(^TMP("PXKENC",$J,VISIT,"CPT",0))
.S REC=0 D:PROV]""
..F S REC=$O(^TMP("PXKENC",$J,VISIT,"CPT",REC)) Q:'REC D Q:CNT>MAXCPT
...S CPT="",NODE=$G(^TMP("PXKENC",$J,VISIT,"CPT",REC,12))
...Q:NODE=""
...S NOD1=$S($P(NODE,U,4)=PROV:^TMP("PXKENC",$J,VISIT,"CPT",REC,0),1:"")
...Q:$P(NOD1,U)=""
...S Q="00"_+$P(NOD1,U,16),Q=$S(+Q:$E(Q,$L(Q)-1,$L(Q)),1:"01")
...S CPT=$P(NOD1,U),M=0,MOD=""
...F I=1:1:MAXMOD S M=$O(^TMP("PXKENC",$J,VISIT,"CPT",REC,1,M)) Q:'M D
....S MOD=MOD_$S(MOD'="":";",1:"")
....S MOD=MOD_$P(^TMP("PXKENC",$J,VISIT,"CPT",REC,1,M,0),U)
...I ECXLOGIC<2019 S ECXVIST("CPT"_CNT)=$$CPT^ECXUTL3(CPT,MOD,Q)
...I ECXLOGIC>2018 S ECXVIST("CPT"_CNT)=$$CPT3Q6M^ECXUTL3(CPT,MOD,Q)
...S:$P(NOD1,U,7)="Y" ECXVIST("PRIMPROC")=ECXVIST("CPT"_CNT) S CNT=CNT+1 ;149
...K ^TMP("PXKENC",$J,VISIT,"CPT",REC)
..Q:CNT>MAXCPT
.Q:CNT>MAXCPT S REC=0
.F S REC=$O(^TMP("PXKENC",$J,VISIT,"CPT",REC)) Q:'REC D Q:CNT>MAXCPT
..S CPT="",NOD1=$G(^TMP("PXKENC",$J,VISIT,"CPT",REC,0))
..Q:$P(NOD1,U)=""
..S Q="00"_+$P(NOD1,U,16),Q=$S(+Q:$E(Q,$L(Q)-1,$L(Q)),1:"01")
..S CPT=$P(NOD1,U),M=0,MOD=""
..F I=1:1:MAXMOD S M=$O(^TMP("PXKENC",$J,VISIT,"CPT",REC,1,M)) Q:'M D
...S MOD=MOD_$S(MOD'="":";",1:"")
...S MOD=MOD_$P(^TMP("PXKENC",$J,VISIT,"CPT",REC,1,M,0),U)
..I ECXLOGIC<2019 S ECXVIST("CPT"_CNT)=$$CPT^ECXUTL3(CPT,MOD,Q)
..I ECXLOGIC>2018 S ECXVIST("CPT"_CNT)=$$CPT3Q6M^ECXUTL3(CPT,MOD,Q)
..S:$P(NOD1,U,7)="Y" ECXVIST("PRIMPROC")=ECXVIST("CPT"_CNT) S CNT=CNT+1 ;149
..K ^TMP("PXKENC",$J,VISIT,"CPT",REC)
..Q:CNT>MAXCPT
I ECXLOGIC<2019 S:ECXVIST("CPT1")="" ECXVIST("CPT1")=9919901
I ECXLOGIC>2018 S:ECXVIST("CPT1")="" ECXVIST("CPT1")=99199001
;ao, ir, mst, pge, hnc, cv, shad
S (AO,IR,MST,PGE,HNC,CV,SHAD,ENCSC,ENCCL)="" ;144
I $D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800)) D
.S ENCSC=$P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800),U) ;144 Encounter Service Connected
.S AO=$P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800),U,2)
.S IR=$P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800),U,3),MST=$P(^(800),U,5)
.S PGE=$P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800),U,4),HNC=$P(^(800),U,6)
.S CV=$P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800),U,7),SHAD=$P(^(800),U,8)
.S ENCCL=$P(^TMP("PXKENC",$J,VISIT,"VST",VISIT,800),U,9) ;144,154 Encounter Camp Lejeune
.S ECXVIST("AO")=$S(AO=0:"N",AO=1:"Y",1:"")
.S ECXVIST("IR")=$S(IR=0:"N",IR=1:"Y",1:"")
.S ECXVIST("MST")=$S(MST=0:"N",MST=1:"Y",1:"")
.S ECXVIST("PGE")=$S(PGE=0:"N",PGE=1:"Y",1:"")
.S ECXVIST("HNC")=$S(HNC=0:"N",HNC=1:"Y",1:"")
.S ECXVIST("CV")=$S(CV=0:"N",CV=1:"Y",1:"")
.S ECXVIST("SHAD")=$S(SHAD=0:"N",SHAD=1:"Y",1:"")
.S ECXVIST("ENCSC")=$S(ENCSC=0:"N",ENCSC=1:"Y",1:"") ;144 Encounter Service Connected
.S ECXVIST("ENCCL")=$S(ENCCL=0:"N",ENCCL=1:"Y",1:"") ;144 Encounter Camp Lejeune.
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXSCX1 12618 printed Apr 09, 2024@20:55:13 Page 2
ECXSCX1 ;ALB/JAP,BIR/DMA-Clinic Extract Message ;2/25/19 11:55
+1 ;;3.0;DSS EXTRACTS;**8,28,24,27,29,30,31,33,84,92,105,127,132,144,149,154,166,170,174,184**;Dec 22, 1997;Build 124
EN ;entry point from ecxscx
+1 NEW ECX
+2 ;send missing clinic message
+3 SET ECX=$ORDER(^TMP($JOB,"ECXS","MISS",0))
Begin DoDot:1
+4 if ECX=""
QUIT
+5 SET XMSUB="MISSING CLINICS in File #728.44"
SET XMDUZ="DSS SYSTEM"
+6 KILL XMY
SET XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
+7 ;174 Add more lines to text
FOR ECX=1:1:8
SET ^TMP($JOB,"ECXS","MISS",ECX,0)=$PIECE($TEXT(MSG+ECX),";;",2)
+8 SET XMTEXT="^TMP($J,""ECXS"",""MISS"","
DO ^XMD
End DoDot:1
+9 ;send no division message
+10 SET ECX=$ORDER(^TMP($JOB,"ECXS","DIV",0))
Begin DoDot:1
+11 if ECX=""
QUIT
+12 SET XMSUB="CLINICS w/o DIVISION Data"
SET XMDUZ="DSS SYSTEM"
+13 KILL XMY
SET XMY("G.DSS-"_ECGRP_"@"_^XMB("NETNAME"))=""
+14 FOR ECX=1:1:5
SET ^TMP($JOB,"ECXS","DIV",ECX,0)=$PIECE($TEXT(MSG2+ECX),";;",2)
+15 SET XMTEXT="^TMP($J,""ECXS"",""DIV"","
DO ^XMD
End DoDot:1
+16 ;cleanup
+17 KILL ^TMP($JOB,"ECXS")
+18 QUIT
MSG ;text for missing clinic
+1 ;;The following clinics have not been entered into the CLINIC AND
+2 ;;STOP CODES file (#728.44). If any listed clinic is currently
+3 ;;active, please use the options 'Create DSS Clinic Stop Code File'
+4 ;;and 'Enter/Edit DSS Stop Codes for Clinics' to update this file.
+5 ;;
+6 ;;CLIN IEN CLINIC NAME STOP/CREDIT STOP
+7 ;;----------------------------------------------------------
+8 ;;
+9 ;
MSG2 ;text for missing division
+1 ;;The following clinics in the HOSPITAL LOCATION file (#44) have not
+2 ;;been assigned to a division from the MEDICAL CENTER DIVISION file
+3 ;;(#40.8). CLI extract records associated with these clinics have
+4 ;;been given a default Division identifier of "1".
+5 ;;
+6 ;
MISS ;load ^tmp if clinic missing from #728.44
+1 NEW DAT,ID,RD
+2 SET (ID,RD)=""
+3 SET DAT=$GET(^SC(SC,"I"))
IF DAT]""
SET ID=+DAT
SET RD=$PIECE(DAT,U,2)
+4 ;ignore inactive clinics
+5 IF ID
IF ID<DT
IF 'RD!(RD>DT)
QUIT
+6 IF '$DATA(^TMP($JOB,"ECXS","ECXMISS"))
SET ^TMP($JOB,"ECXS","ECXMISS")=10
+7 SET ECXMISS=^TMP($JOB,"ECXS","ECXMISS")
+8 ;174 Report codes instead of IENs
SET ^TMP($JOB,"ECXS","MISS",ECXMISS,0)=$JUSTIFY(SC,8)_" "_$$LJ^XLFSTR($PIECE(^SC(SC,0),U),32)_$SELECT(ECSC:$$GET1^DIQ(40.7,ECSC_",",1),1:"")_"/"_$SELECT(ECCSC:$$GET1^DIQ(40.7,ECCSC_",",1),1:"")
+9 SET ^TMP($JOB,"ECXS","ECXMISS")=ECXMISS+1
+10 QUIT
+11 ;
NODIV ;load ^tmp if clinic w/o division
+1 NEW DAT,ID,RD
+2 SET (ID,RD)=""
+3 SET DAT=$GET(^SC(SC,"I"))
IF DAT]""
SET ID=+DAT
SET RD=$PIECE(DAT,U,2)
+4 ;ignore inactive clinics
+5 IF ID
IF ID<DT
IF 'RD!(RD>DT)
QUIT
+6 IF '$DATA(^TMP($JOB,"ECXS","ECXMISS"))
SET ^TMP($JOB,"ECXS","ECXMISS")=10
+7 SET ECXMISS=^TMP($JOB,"ECXS","ECXMISS")
+8 SET ^TMP($JOB,"ECXS","DIV",ECXMISS,0)=$JUSTIFY(SC,6)_" "_$$LJ^XLFSTR($PIECE(^SC(SC,0),U),40)
+9 SET ^TMP($JOB,"ECXS","ECXMISS")=ECXMISS+1
+10 QUIT
+11 ;
FEEDER(ECXSC,ECXSD,ECXP1,ECXP2,ECXP3,ECXSEND,ECXDIV,ECXP4) ;166 - get transmission style and feeder key variables. New parameter added for labor code
+1 ;feeder key = primary stop code_secondary stop code_length of appointment_national clinic code_noshow indicator_labor code
+2 ; input
+3 ; ECXSC = ien of clinic in file #44 (required)
+4 ; ECXSD = start date of extract date range (required)
+5 ; ECXP1,ECXP2,ECXP3,ECXP4,ECXSEND passed by reference (required)
+6 ; output (passed-by-reference variables)
+7 ; ECXP1 = primary stop code
+8 ; ECXP2 = secondary stop code
+9 ; ECXP3 = field #7 of file #728.44
+10 ; ECXP4 = field #13 of file #728.44
+11 ; ECXSEND = field #5 of file #728.44
+12 ; ECXDIV = field #3.5 of file #44
+13 ;166
NEW ECSC,ECCSC,ECSD1,ECXNC,ECXMISS,CLIN,SC,ECXMLC
+14 ;166
SET (ECXP1,ECXP2)="000"
SET ECXP3="0000"
SET ECXP4=""
+15 SET ECXSEND=1
SET ECXDIV=0
+16 if +ECXSC=0
QUIT
+17 ;get needed data from ^tmp
+18 IF $DATA(^TMP($JOB,"ECXS","SC",ECXSC))
Begin DoDot:1
+19 SET CLIN=^TMP($JOB,"ECXS","SC",ECXSC)
+20 ;166
SET ECXP1=$PIECE(CLIN,U)
SET ECXP2=$PIECE(CLIN,U,2)
SET ECXP3=$PIECE(CLIN,U,3)
SET ECXSEND=$PIECE(CLIN,U,4)
SET ECXP4=$PIECE(CLIN,U,5)
+21 SET ECXDIV=+$PIECE($GET(^TMP($JOB,"ECXCL",ECXSC)),U,4)
if ECXDIV=0
SET ECXDIV=1
End DoDot:1
+22 ;otherwise, set needed data in ^tmp
+23 IF '$DATA(^TMP($JOB,"ECXS","SC",ECXSC))
Begin DoDot:1
+24 ;get division or send no division msg
+25 SET ECXDIV=+$PIECE($GET(^TMP($JOB,"ECXCL",ECXSC)),U,4)
+26 IF ECXDIV=0
SET SC=ECXSC
DO NODIV
SET ECXDIV=1
+27 ;get other data from file #44 if no #728.44 record; send missing clinic msg
+28 IF '$DATA(^ECX(728.44,ECXSC,0))
Begin DoDot:2
+29 SET ECSC=+$PIECE($GET(^SC(ECXSC,0)),U,7)
SET ECCSC=+$PIECE(^(0),U,18)
+30 SET SC=ECXSC
SET ECSD1=ECXSD
DO MISS
+31 if ECSC
SET ECXP1=$PIECE($GET(^DIC(40.7,ECSC,0)),U,2)
SET ECXP1=$$RJ^XLFSTR(+ECXP1,3,0)
End DoDot:2
+32 ;otherwise get other data from file #728.44
+33 SET EC=$GET(^ECX(728.44,ECXSC,0))
Begin DoDot:2
+34 if EC=""
QUIT
+35 SET ECXSEND=$PIECE(EC,U,6)
+36 if ECXSEND=6
QUIT
+37 SET ECSC=+$PIECE(EC,U,4)
SET ECCSC=+$PIECE(EC,U,5)
+38 IF 'ECSC
SET ECSC=+$PIECE(EC,U,2)
SET ECCSC=+$PIECE(EC,U,3)
+39 IF ECSC
SET ECXP1=$$RJ^XLFSTR(ECSC,3,0)
SET ECXP2=$$RJ^XLFSTR(ECCSC,3,0)
+40 ;if primary stop not valid, use file #44 record
+41 IF 'ECSC
SET ECSC=+$PIECE($GET(^SC(ECXSC,0)),U,7)
SET ECCSC=+$PIECE($GET(^(0)),U,18)
IF ECSC
Begin DoDot:3
+42 SET ECXP1=+$PIECE($GET(^DIC(40.7,ECSC,0)),U,2)
+43 if ECCSC
SET ECXP2=+$PIECE($GET(^DIC(40.7,ECCSC,0)),U,2)
+44 SET ECXP1=$$RJ^XLFSTR(ECXP1,3,0)
SET ECXP2=$$RJ^XLFSTR(ECXP2,3,0)
End DoDot:3
End DoDot:2
+45 ;for action code=1, secondary stop code is always "000"
+46 IF ECXSEND=1
SET ECXP2="000"
+47 ;action code of 2 or 3 should not be used, but continue to follow v2t11 logic
+48 IF ECXSEND=2
SET ECXP1=ECXP2
SET ECXP2="000"
+49 ;for action code=4, need to get national clinic code
+50 IF ECXSEND=4
Begin DoDot:2
+51 SET ECXNC=+$PIECE($GET(^ECX(728.44,ECXSC,0)),U,8)
+52 IF ECXNC
SET ECXNC=$PIECE($GET(^ECX(728.441,ECXNC,0)),U)
SET ECXP3=$$RJ^XLFSTR(ECXNC,4,0)
End DoDot:2
+53 ;set data in ^tmp
+54 ;166 Get labor code from 728.44 but only use it if it's FY18 or later
SET ECXMLC=$SELECT($GET(ECXLOGIC)>2017:$$GET1^DIQ(728.44,ECXSC,13),1:"")
+55 ;166 Add MCAO Labor Code
SET ^TMP($JOB,"ECXS","SC",ECXSC)=ECXP1_U_ECXP2_U_ECXP3_U_ECXSEND_U_ECXMLC
End DoDot:1
+56 QUIT
+57 ;
VISIT(ECXDFN,ECXVISIT,ECXVIST,ECXERR) ;get visit specific data
+1 ;input ECXVISIT = pointer to file #9000010
+2 ; ECXSVC = sc percentage
+3 ;output ECXVSIT = data array
+4 ; ECXERR = 1 indicates error; otherwise, 0
+5 NEW AO,ARRAY,CM,CNT,CPT,DA,DATE,DA,DIQ,ICD,ICD9,IR,LEN,M,MOD,MST,NUM,NOD1,NODE
+6 ;144
NEW PROV,PROVPC,REC,VAL,VISIT,X,Y,HNC,PGE,CV,SHAD,ENCSC,ENCCL
+7 ;170
NEW MAXCPT,MAXMOD
+8 ;184
NEW PROVX12
+9 ;170
SET MAXCPT=8
if ECXLOGIC>2018
SET MAXCPT=25
+10 ;170
SET MAXMOD=5
if ECXLOGIC>2018
SET MAXMOD=6
+11 SET ECXERR=0
SET VISIT=ECXVISIT
+12 SET (ECXVIST("AO"),ECXVIST("IR"),ECXVIST("PGE"),ECXVIST("HNC"))=""
+13 ;144
SET (ECXVIST("MST"),ECXVIST("CV"),ECXVIST("SHAD"),ECXVIST("ENCSC"),ECXVIST("ENCCL"))=""
+14 ;MRY-2/4/2010, extracts don't seem to use encounter (visit) "CV".
+15 ;extracts use eligibility API for some reason. Added "CV" anyway.
+16 SET (ECXVIST("PROV"),ECXVIST("PROV CLASS"))=""
+17 SET (ECXVIST("PROV NPI"),ECXVIST("SOURCE"))=""
+18 ;184
SET ECXVIST("PROV X12")=""
+19 FOR I="P",1,2,3,4
SET ECXVIST("ICD9"_I)=""
+20 FOR I=1:1:MAXCPT
SET ECXVIST("CPT"_I)=""
+21 DO ENCEVENT^PXAPI(VISIT)
+22 IF $ORDER(^TMP("PXKENC",$JOB,VISIT,""))']""
KILL ECXVIST
SET ECXERR=1
+23 if ECXERR
QUIT
+24 SET DATE=$PIECE($PIECE(^TMP("PXKENC",$JOB,VISIT,"VST",VISIT,0),U,1),".",1)
+25 SET ECXVIST("SOURCE")=$PIECE($GET(^TMP("PXKENC",$JOB,VISIT,"VST",VISIT,812)),U,3)
+26 ;get icd codes upto 5, will be stored in ICD9 named variables, even if they're 10 codes (or any future version)
+27 KILL ARY
SET ICD("P")=0
SET ICD("S")=0
SET (ARY,REC)=""
+28 FOR
SET REC=$ORDER(^TMP("PXKENC",$JOB,VISIT,"POV",REC))
if REC=""
QUIT
Begin DoDot:1
+29 SET VAL=^TMP("PXKENC",$JOB,VISIT,"POV",REC,0)
if 'VAL
QUIT
+30 IF $PIECE(VAL,U,12)="P"
Begin DoDot:2
+31 if '$DATA(ARY("P",+VAL))
SET CNT=ICD("P")+1
SET ICD("P",CNT)=+VAL
SET ICD("P")=CNT
+32 SET ARY("P",+VAL)=""
End DoDot:2
+33 IF $PIECE(VAL,U,12)'="P"
Begin DoDot:2
+34 if '$DATA(ARY("S",+VAL))
SET CNT=ICD("S")+1
SET ICD("S",CNT)=+VAL
SET ICD("S")=CNT
+35 SET ARY("S",+VAL)=""
End DoDot:2
End DoDot:1
+36 ;154 Get code if value exists in ICD("P",1) else return null
SET CNT=0
SET ECXVIST("ICD9P")=$SELECT(+$GET(ICD("P",1)):$$CODEC^ICDEX(80,ICD("P",1)),1:"")
+37 FOR I=2:1
if '$DATA(ICD("P",I))
QUIT
Begin DoDot:1
+38 ;154 Get code if value exists in ICD("P",I) else return null
SET CNT=CNT+1
SET ECXVIST("ICD9"_CNT)=$SELECT(+$GET(ICD("P",I)):$$CODEC^ICDEX(80,ICD("P",I)),1:"")
End DoDot:1
if CNT>4
QUIT
+39 IF CNT<4
FOR I=1:1:8
if '$DATA(ICD("S",I))
QUIT
Begin DoDot:1
+40 IF '$DATA(ARY("P",ICD("S",I)))
Begin DoDot:2
+41 ;154 Get code if value exists in ICD("S",I) else return null
SET CNT=CNT+1
SET ECXVIST("ICD9"_CNT)=$SELECT(+$GET(ICD("S",I)):$$CODEC^ICDEX(80,ICD("S",I)),1:"")
End DoDot:2
End DoDot:1
if CNT>4
QUIT
+42 ;get first provider designated as primary
+43 ;if no primary, then get first physician provider
+44 ;if no physician, then get first provider
+45 SET (PROV,PROVPC)=""
+46 ;184 - Provider Taxonomy (X12 Code)
SET PROVX12=""
+47 IF $ORDER(^TMP("PXKENC",$JOB,VISIT,"PRV",0))
Begin DoDot:1
+48 SET (REC,VAL)=0
Begin DoDot:2
+49 FOR
SET REC=$ORDER(^TMP("PXKENC",$JOB,VISIT,"PRV",REC))
if ('REC)!(VAL)
QUIT
Begin DoDot:3
+50 if ($PIECE(^(REC,0),U,4)="P")
SET VAL=+^(0)
+51 SET PROV=VAL
SET PROVPC=$$PRVCLASS^ECXUTL(PROV,DATE)
+52 ;184 - Provider Taxonomy
SET PROVX12=$$PRVX12^ECXUTL(PROV,DATE)
End DoDot:3
End DoDot:2
+53 IF 'VAL
SET (REC,VAL)=0
Begin DoDot:2
+54 FOR
SET REC=$ORDER(^TMP("PXKENC",$JOB,VISIT,"PRV",REC))
if ('REC)!(VAL)
QUIT
Begin DoDot:3
+55 SET (PROV,VAL)=+^(REC,0)
+56 SET PROVPC=$$PRVCLASS^ECXUTL(PROV,DATE)
if PROVPC=""
QUIT
+57 ;184 - Provider Taxonomy
SET PROVX12=$$PRVX12^ECXUTL(PROV,DATE)
+58 SET NUM=$EXTRACT(PROVPC,2,7)
if (NUM<110000)!(NUM>119999)
SET VAL=0
SET PROVPC=""
End DoDot:3
End DoDot:2
+59 IF 'VAL
Begin DoDot:2
+60 SET REC=$ORDER(^TMP("PXKENC",$JOB,VISIT,"PRV",0))
if ('REC)!(VAL)
QUIT
+61 SET VAL=+^(REC,0)
SET PROV=VAL
SET PROVPC=$$PRVCLASS^ECXUTL(PROV,DATE)
+62 ;184 - Provider Taxonomy
SET PROVX12=$$PRVX12^ECXUTL(PROV,DATE)
End DoDot:2
+63 if PROV]""
SET PROV="2"_PROV
End DoDot:1
+64 SET ECXVIST("PROV")=PROV
SET ECXVIST("PROV CLASS")=PROVPC
+65 SET ECXVIST("PROV NPI")=""
+66 ;184
SET ECXVIST("PROV X12")=PROVX12
+67 ;get 1-7 secondary physicians
+68 ;144 two more providers cvw
FOR I=1:1:7
SET ECXVIST("PROVS"_I)=""
+69 IF $ORDER(^TMP("PXKENC",$JOB,VISIT,"PRV",0))
Begin DoDot:1
+70 SET (REC,VAL,COUNTS)=0
Begin DoDot:2
+71 FOR
SET REC=$ORDER(^TMP("PXKENC",$JOB,VISIT,"PRV",REC))
if ('REC)
QUIT
Begin DoDot:3
+72 if $PIECE(^(REC,0),U,4)'="S"
QUIT
+73 ;don't process, primary
SET VAL=+^(0)
IF $EXTRACT(PROV,2,99)=VAL
QUIT
+74 ;144 two more providers cvw
SET COUNTS=COUNTS+1
if (COUNTS>7)
QUIT
+75 SET PROVS=VAL
SET PROVSPC=$$PRVCLASS^ECXUTL(PROVS,DATE)
+76 SET PROVSNPI=$$NPI^XUSNPI("Individual_ID",PROVS,DATE)
+77 if +PROVSNPI'>0
SET PROVSNPI=""
SET PROVSNPI=$PIECE(PROVSNPI,U)
+78 SET ECXVIST("PROVS"_COUNTS)="2"_PROVS_U_PROVSPC_U_PROVSNPI
End DoDot:3
End DoDot:2
End DoDot:1
+79 ;get cpt codes up to MAXCPT & modifiers up to MAXMOD
+80 SET CNT=1
SET PROV=$EXTRACT(PROV,2,99)
+81 ;149 Initialize primary procedure
SET ECXVIST("PRIMPROC")=""
+82 if $ORDER(^TMP("PXKENC",$JOB,VISIT,"CPT",0))
Begin DoDot:1
+83 SET REC=0
if PROV]""
Begin DoDot:2
+84 FOR
SET REC=$ORDER(^TMP("PXKENC",$JOB,VISIT,"CPT",REC))
if 'REC
QUIT
Begin DoDot:3
+85 SET CPT=""
SET NODE=$GET(^TMP("PXKENC",$JOB,VISIT,"CPT",REC,12))
+86 if NODE=""
QUIT
+87 SET NOD1=$SELECT($PIECE(NODE,U,4)=PROV:^TMP("PXKENC",$JOB,VISIT,"CPT",REC,0),1:"")
+88 if $PIECE(NOD1,U)=""
QUIT
+89 SET Q="00"_+$PIECE(NOD1,U,16)
SET Q=$SELECT(+Q:$EXTRACT(Q,$LENGTH(Q)-1,$LENGTH(Q)),1:"01")
+90 SET CPT=$PIECE(NOD1,U)
SET M=0
SET MOD=""
+91 FOR I=1:1:MAXMOD
SET M=$ORDER(^TMP("PXKENC",$JOB,VISIT,"CPT",REC,1,M))
if 'M
QUIT
Begin DoDot:4
+92 SET MOD=MOD_$SELECT(MOD'="":";",1:"")
+93 SET MOD=MOD_$PIECE(^TMP("PXKENC",$JOB,VISIT,"CPT",REC,1,M,0),U)
End DoDot:4
+94 IF ECXLOGIC<2019
SET ECXVIST("CPT"_CNT)=$$CPT^ECXUTL3(CPT,MOD,Q)
+95 IF ECXLOGIC>2018
SET ECXVIST("CPT"_CNT)=$$CPT3Q6M^ECXUTL3(CPT,MOD,Q)
+96 ;149
if $PIECE(NOD1,U,7)="Y"
SET ECXVIST("PRIMPROC")=ECXVIST("CPT"_CNT)
SET CNT=CNT+1
+97 KILL ^TMP("PXKENC",$JOB,VISIT,"CPT",REC)
End DoDot:3
if CNT>MAXCPT
QUIT
+98 if CNT>MAXCPT
QUIT
End DoDot:2
+99 if CNT>MAXCPT
QUIT
SET REC=0
+100 FOR
SET REC=$ORDER(^TMP("PXKENC",$JOB,VISIT,"CPT",REC))
if 'REC
QUIT
Begin DoDot:2
+101 SET CPT=""
SET NOD1=$GET(^TMP("PXKENC",$JOB,VISIT,"CPT",REC,0))
+102 if $PIECE(NOD1,U)=""
QUIT
+103 SET Q="00"_+$PIECE(NOD1,U,16)
SET Q=$SELECT(+Q:$EXTRACT(Q,$LENGTH(Q)-1,$LENGTH(Q)),1:"01")
+104 SET CPT=$PIECE(NOD1,U)
SET M=0
SET MOD=""
+105 FOR I=1:1:MAXMOD
SET M=$ORDER(^TMP("PXKENC",$JOB,VISIT,"CPT",REC,1,M))
if 'M
QUIT
Begin DoDot:3
+106 SET MOD=MOD_$SELECT(MOD'="":";",1:"")
+107 SET MOD=MOD_$PIECE(^TMP("PXKENC",$JOB,VISIT,"CPT",REC,1,M,0),U)
End DoDot:3
+108 IF ECXLOGIC<2019
SET ECXVIST("CPT"_CNT)=$$CPT^ECXUTL3(CPT,MOD,Q)
+109 IF ECXLOGIC>2018
SET ECXVIST("CPT"_CNT)=$$CPT3Q6M^ECXUTL3(CPT,MOD,Q)
+110 ;149
if $PIECE(NOD1,U,7)="Y"
SET ECXVIST("PRIMPROC")=ECXVIST("CPT"_CNT)
SET CNT=CNT+1
+111 KILL ^TMP("PXKENC",$JOB,VISIT,"CPT",REC)
+112 if CNT>MAXCPT
QUIT
End DoDot:2
if CNT>MAXCPT
QUIT
End DoDot:1
+113 IF ECXLOGIC<2019
if ECXVIST("CPT1")=""
SET ECXVIST("CPT1")=9919901
+114 IF ECXLOGIC>2018
if ECXVIST("CPT1")=""
SET ECXVIST("CPT1")=99199001
+115 ;ao, ir, mst, pge, hnc, cv, shad
+116 ;144
SET (AO,IR,MST,PGE,HNC,CV,SHAD,ENCSC,ENCCL)=""
+117 IF $DATA(^TMP("PXKENC",$JOB,VISIT,"VST",VISIT,800))
Begin DoDot:1
+118 ;144 Encounter Service Connected
SET ENCSC=$PIECE(^TMP("PXKENC",$JOB,VISIT,"VST",VISIT,800),U)
+119 SET AO=$PIECE(^TMP("PXKENC",$JOB,VISIT,"VST",VISIT,800),U,2)
+120 SET IR=$PIECE(^TMP("PXKENC",$JOB,VISIT,"VST",VISIT,800),U,3)
SET MST=$PIECE(^(800),U,5)
+121 SET PGE=$PIECE(^TMP("PXKENC",$JOB,VISIT,"VST",VISIT,800),U,4)
SET HNC=$PIECE(^(800),U,6)
+122 SET CV=$PIECE(^TMP("PXKENC",$JOB,VISIT,"VST",VISIT,800),U,7)
SET SHAD=$PIECE(^(800),U,8)
+123 ;144,154 Encounter Camp Lejeune
SET ENCCL=$PIECE(^TMP("PXKENC",$JOB,VISIT,"VST",VISIT,800),U,9)
+124 SET ECXVIST("AO")=$SELECT(AO=0:"N",AO=1:"Y",1:"")
+125 SET ECXVIST("IR")=$SELECT(IR=0:"N",IR=1:"Y",1:"")
+126 SET ECXVIST("MST")=$SELECT(MST=0:"N",MST=1:"Y",1:"")
+127 SET ECXVIST("PGE")=$SELECT(PGE=0:"N",PGE=1:"Y",1:"")
+128 SET ECXVIST("HNC")=$SELECT(HNC=0:"N",HNC=1:"Y",1:"")
+129 SET ECXVIST("CV")=$SELECT(CV=0:"N",CV=1:"Y",1:"")
+130 SET ECXVIST("SHAD")=$SELECT(SHAD=0:"N",SHAD=1:"Y",1:"")
+131 ;144 Encounter Service Connected
SET ECXVIST("ENCSC")=$SELECT(ENCSC=0:"N",ENCSC=1:"Y",1:"")
+132 ;144 Encounter Camp Lejeune.
SET ECXVIST("ENCCL")=$SELECT(ENCCL=0:"N",ENCCL=1:"Y",1:"")
End DoDot:1
+133 QUIT
