ECXSCXN ;ALB/JAP Clinic Extract ;Mar 18, 2021@15:55:41
;;3.0;DSS EXTRACTS;**24,27,29,30,31,32,33,39,46,49,52,71,84,92,107,105,120,124,127,132,136,144,149,156,154,161,166,170,174,178,181,184**;Dec 22, 1997;Build 124
;
; Reference to ^DIC(4) in ICR #10090
; Reference to ^SC in ICR #10040
;
BEG ;entry point from option
D SETUP Q:ECFILE="" D ^ECXTRAC,^ECXKILL
Q
;
START ;entry point from taskmgr
N DIC,EXNUM,I,LOCARR,OUT,P1,P2,P3,P4,PROCESS,SOURCE,STOP,STAT,TOSEND ;166
N TIU,X,Y,ECXNPRFI,DSIPIEN,DSITIEN ;184 Added DSIPIEN,DSITIEN
N ECXICD10P,ECXICD101,ECXICD102,ECXICD103,ECXICD104
F I=1:1:8 S @("ECXCPT"_I)=""
F I=1:1:4 S @("ECXICD9"_I)=""
F I=1:1:4 S @("ECXICD10"_I)=""
F I=1:1:25 S @("ECXCQM"_I)="" ;170 - initialize the 25 new CPT variables
S (OUT,QFLG,ECRN)=0,(ECXICD9P,ECXOBI,ECXICD10P)=""
K ^TMP($J,"ECXS"),^TMP($J,"ECXCL"),^TMP($J,"SDAMA301") ;136
;get ien for tiu in file #839.7
S DIC="^PX(839.7,",DIC(0)="X",X="TEXT INTEGRATION UTILITIES"
D ^DIC S TIU=+Y,ECED=ECED+.3,ECXCLIN=0 K DIC,Y
S DIC="^PX(839.7,",DIC(0)="X",X="DSIP DSS PCE"
D ^DIC S DSIPIEN=+Y K DIC,Y
S DIC="^PX(839.7,",DIC(0)="X",X="DSIT DSS PCE"
D ^DIC S DSITIEN=+Y K DIC,Y
;get clinic default appt length, type, division
F S ECXCLIN=$O(^SC(ECXCLIN)) Q:'ECXCLIN D
.K LOCARR S DIC=44,DA=ECXCLIN,DR="2;3.5;1912;2502",DIQ(0)="I",DIQ="LOCARR" ;174 Added 2502, non-count field
.D EN^DIQ1
.Q:$G(LOCARR(44,ECXCLIN,2,"I"))'="C"
.S ALEN=+$G(LOCARR(44,ECXCLIN,1912,"I"))
.S ^TMP($J,"ECXCL",ECXCLIN)=ALEN,ALEN=$$RJ^XLFSTR(ALEN,3,0)
.S ^TMP($J,"ECXCL",ECXCLIN)=^TMP($J,"ECXCL",ECXCLIN)_"^"_ALEN_"^"_$G(LOCARR(44,ECXCLIN,2,"I"))_"^"_+$G(LOCARR(44,ECXCLIN,3.5,"I"))_"^"_$S($G(LOCARR(44,ECXCLIN,2502,"I"))="Y":"Y",1:"") ;174 Set non-count flag
.D FEEDER^ECXSCX1(ECXCLIN,ECSD1,.P1,.P2,.P3,.TOSEND,.ECXDIV,.P4) ;166
.K P1,P2,P3,P4,TOSEND,ECXDIV ;166
;get from file #44 any no-shows & get encounters from #409.68
D NOSHOW^ECXSCXN1(ECSD1,ECED),ENCNTR(ECSD1,ECED)
;send missing clinic msg
D:$D(^TMP($J,"ECXS")) EN^ECXSCX1
K ^TMP($J,"ECXS"),^TMP($J,"ECXCL"),^TMP($J,"SDAMA301") ;136
Q
;
ENCNTR(ECSD1,ECED) ;search file #409.68 for encounter data
N CHKOUT,ECD,STAT,STOP,MDIV,ECXEDIS,CNT,ECXARR,NODE ;136
N ECXESC,ECXECL,ECXCLST,ECXPP,ECXASIH,ECXSCST,ECXNOCNT ;149,170,174
N ECXNMPI,ECXSTA6,ECXPRX12,ECXCERN1,ECXCERN2,ECXSIGI,ECXCSTA6 ;184
S (ECXCERN1,ECXCERN2,ECXCSTA6)="" ;184
S ECD=ECSD1
F S ECD=$O(^SCE("B",ECD)) Q:('ECD!(ECD>ECED))!(QFLG) S ECXIEN=0 D
.F S ECXIEN=$O(^SCE("B",ECD,ECXIEN)) Q:'ECXIEN D Q:QFLG
..Q:'$D(^SCE(ECXIEN,0))
..D INTPAT^ECXSCX2 K LOCARR S DIC=409.68,DA=ECXIEN
..S DR=".01;.02;.03;.04;.05;.06;.07;.08;.11;.12;.13",DIQ(0)="I",DIQ="LOCARR"
..D EN^DIQ1
..S ECXTI=$$ECXTIME^ECXUTL(+$G(LOCARR(409.68,ECXIEN,.01,"I"))) ;166
..S MDIV=+$G(LOCARR(409.68,ECXIEN,.11,"I")) ;166
..S STOP=+$G(LOCARR(409.68,ECXIEN,.03,"I"))
..S CHKOUT=+$G(LOCARR(409.68,ECXIEN,.07,"I"))
..S PROCESS=+$G(LOCARR(409.68,ECXIEN,.08,"I"))
..S STAT=$G(LOCARR(409.68,ECXIEN,.12,"I"))
..S ECXDFN=+$G(LOCARR(409.68,ECXIEN,.02,"I"))
..Q:(ECXDFN=0)!('CHKOUT)
..S:STAT="" STAT="ZZ" S STAT=";"_STAT_";"
..Q:";3;4;5;6;7;9;10;13;"[STAT
..Q:('STOP)!(PROCESS=4)!(+$G(LOCARR(409.68,ECXIEN,.06,"I")))
..S ECXDATE=+$G(LOCARR(409.68,ECXIEN,.01,"I"))
..S ECXCLIN=+$G(LOCARR(409.68,ECXIEN,.04,"I"))
..Q:$P($G(^TMP($J,"ECXCL",ECXCLIN)),U,3)'="C"
..S ECXVISIT=+$G(LOCARR(409.68,ECXIEN,.05,"I"))
..S ECXENEL=+$G(LOCARR(409.68,ECXIEN,.13,"I"))
..Q:'ECXVISIT
..S ECXERR=0
..D PAT1^ECXSCX2(ECXDFN,ECXDATE,.ECXERR) Q:ECXERR
..I ECXLOGIC>2022 S ECXNMPI=ECXMPI ;184
..D FEEDER^ECXSCX1(ECXCLIN,ECSD1,.P1,.P2,.P3,.TOSEND,.ECXDIV,.P4) ;166
..Q:TOSEND=6
..S ECXNOCNT=$P($G(^TMP($J,"ECXCL",ECXCLIN)),U,5) ;174 Get non-count flag
..K LOCARR S DIC=40.7,DA=STOP,DR="1",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1
..S ECXSTOP=$$RJ^XLFSTR($G(LOCARR(40.7,STOP,1,"I")),3,0)
..; ******* - PATCH 127, ADD PATCAT CODE ********
..S ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN)
..;get date specific patient data
..D PAT2^ECXSCX2(ECXDFN,ECXDATE)
..;get national patient record flag if exist
..D NPRF^ECXUTL5
..;get visit specific data
..S ECXERR=0 D VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR) Q:ECXERR
..I ECXLOGIC<2019 D ;170 Eight CPT Codes prior to FY19
...F I=1:1:8 S @("ECXCPT"_I)=$G(ECXVIST("CPT"_I))
..I ECXLOGIC>2018 D ;170 Twenty-five CPT Codes starting in FY19
...F I=1:1:25 S @("ECXCQM"_I)=$G(ECXVIST("CPT"_I))
..S ECXPP=$G(ECXVIST("PRIMPROC")) ;149 Get primary procedure if available
..F I="P",1:1:4 S @("ECXICD10"_I)=ECXVIST("ICD9"_I) ;161
..S SOURCE=ECXVIST("SOURCE"),ECXAO=ECXVIST("AO"),ECXIR=ECXVIST("IR")
..S ECXMIL=ECXVIST("MST"),ECXPROV=ECXVIST("PROV"),ECXSHAD=ECXVIST("SHAD")
..S ECXECL=ECXVIST("ENCCL"),ECXESC=ECXVIST("ENCSC") ;144
..S ECPRNPI=$$NPI^XUSNPI("Individual_ID",ECXPROV,ECXDATE)
..S:+ECPRNPI'>0 ECPRNPI="" S ECPRNPI=$P(ECPRNPI,U)
..S ECXPROVP=ECXVIST("PROV CLASS"),ECXPROVN=ECXVIST("PROV NPI")
..S ECXPRX12=ECXVIST("PROV X12") ;184
..F I=1:1:7 S @("ECSP"_I)=$P($G(ECXVIST("PROVS"_I)),U) ;144 2 new prov
..F I=1:1:7 S @("ECSPPC"_I)=$P($G(ECXVIST("PROVS"_I)),U,2) ;144 2 new person class
..F I=1:1:7 S @("ECSPNPI"_I)=$P($G(ECXVIST("PROVS"_I)),U,3) ;144 2 new NPI
..S ECXECE=ECXVIST("PGE"),ECXHNC=ECXVIST("HNC")
..K LOCARR S DIC=8,DA=ECXENEL,DR="8",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1
..S ECXENEL=+$G(LOCARR(8,ECXENEL,8,"I"))
..S:ECXENEL ECXENEL=$$ELIG^ECXUTL3(ECXENEL,ECXSVC)
..S ECXCBOC=$S(MDIV'="":$$CBOC^ECXSCX2(.MDIV),1:"") ;is cboc facility?
..S ECXEDIS=$$EDIS^ECXUTL1(ECXDFN,ECD,"C",ECXVISIT,ECXSTOP) ;136 Set emergency room disposition
..;setup feeder key and file in extract records
..S (ECXKEY,ECXDSSD)=""
..;appointments
..I PROCESS=1 D Q ;get appt length 136 Section changed to use SDAMA301 call
...N CNT,ECXARR
...K ^TMP($J,"SDAMA301")
...S ECXARR(1)=ECXDATE_";"_ECXDATE,ECXARR(2)=ECXCLIN,ECXARR(4)=ECXDFN,ECXARR("FLDS")="5;7;10;18" S CNT=$$SDAPI^SDAMA301(.ECXARR)
...Q:CNT=0 I CNT=-1 D ERR^ECXUTL1 S QFLG=1 Q ;Stop if no appts (CNT=0) send error message and stop extract if CNT=-1 (system error)
...S NODE=^TMP($J,"SDAMA301",ECXDFN,ECXCLIN,ECXDATE)
...S ECXOBI=$S($P(NODE,U,7)="Y":"O",1:"") ;convert overbook indicator from Y to O otherwise send null
...S ALEN=$$RJ^XLFSTR($P(NODE,U,5),3,0)
...S:+ALEN=0 ALEN=$P($G(^TMP($J,"ECXCL",ECXCLIN)),U,2) ;156-modified global ref to "ECXCL"
...S ECXSTOP=P1
...S ECXPVST=+$P(NODE,U,18),ECXATYP=+$P(NODE,U,10)
...I TOSEND'=3 D
....S ECXKEY=P1_P2_ALEN_P3_"0"_P4,ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) ;166
....S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE
...I TOSEND=3 D
....S ECXKEY=P1_"000"_ALEN_P3_"0"_P4,ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) ;166
....S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE
...I TOSEND=3 D
....S ECXKEY=P2_"000"_ALEN_P3_"0"_P4,ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) ;166
....S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE
..I PROCESS=2 D Q
...S ALEN=0
...I SOURCE=TIU S ALEN=$P($G(^TMP($J,"ECXCL",ECXCLIN)),U,2)
...I ECXLOGIC>2022 D ;184
....I SOURCE=DSIPIEN S ALEN=$P($G(^TMP($J,"ECXCL",ECXCLIN)),U,2) ;184
....I SOURCE=DSITIEN S ALEN=$P($G(^TMP($J,"ECXCL",ECXCLIN)),U,2) ;184
...S:+ALEN=0 ALEN="030" S ECXKEY=P1_P2_ALEN_P3_"0"_P4,ECXSTOP=P1 ;166
...S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY)
...S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE
..;dispositions
..I PROCESS=3 D Q
...S ECXKEY=ECXSTOP_"00006000000"_P4,ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) ;166,170
...S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE
Q
;
FILE ;record setup for file #727.827
;NODE(0)
;Sequence Number,Year Month, Extract Number (EC23)^facility (ECXDIV)^
;dfn (ECXDFN)^ssn (ECXSSN)^name (ECXPNM)^
;in/out (ECXA)^Day $$ECXDATE^ECXUTL(ECXDATE,ECXYM)^Placehold Feeder Key (FY<2018) (ECXKEY) ^
;Overbooked Indicator (ECXOBI)^Clinic Name (NOW NULL)^Treating Specialty (ECXTSC) ^
;Time (ECXTI)^Placehold Primary Care Team (ECPTTM)^Placehold primary care provider(ECPTPR)^
;Placehold Primary Care PRV Person Class(ECCLAS)^Provider (ECXPROV)^
;provider person class (ECPROVP)^Placehold CPT Qty & Mods #1 (ECXCPT1)^
;Placehold CPT Qty & Mods #2 (ECXCPT2)^Placehold CPT Qty & Mods #3 (ECXCPT3)^
;Placehold CPT Qty & Mods #4 (ECXCPT4)^Placehold CPT Qty & Mods #5 (ECXCPT5)^
;NODE(1)
;Placehold CPT Qty & Mods #6 (ECXCPT6)^Placehold CPT Qty & Mods #7 (ECXCPT7)^
;Placehold CPT Qty & Mods #8 (ECXCPT8)^Placeholder (ECXICD9P)^
;Placeholder (ECXICD91)^Placeholder (ECXICD92)
;Placeholder (ECXICD93)^Placeholder (ECXICD94)
;date of birth (ECDOB)^Eligibility (ECXELIG)^Veteran (ECXVET)^
;Placehold Race (ECXRACE)^POW status (ECXPST)^POW Location (ECXPLOC)^ Radiation Status(ECXRST)^
;Radiation Encounter Indicator (ECXIR)^Agent Orange Status (ECXAST)^
;Agent Orange Location(ECXAO)^Master Patient Index ((ECXMPI)^PLACEHOLD DSS Product Department (ECXDSSD)^
;Sex (ECXSEX)^zip code (ECXZIP)^Place Holder^Place Holder^Encounter Eligibility (ECXENEL)^
;MST Status(ECXMST)^MST Encounter Indicator (ECXMIL)^PLACEHOLD Sharing Payor^PLACEHOLD Sharing Ins^
;Enrollment Location ((ECXENRL)^State (ECXSTATE)^County (ECXCNTY)^
;Placehold Associate PC Provider (ECASPR)^Placehold Associate PC Prov. Person Class (ECCLAS2)^Place Holder^
;DOM, PRRTP AND SAARTP Indicator (ECXDOM)^ Enrollment Category (ECXCAT)^
;NODE(2)
;Enrollment Status (ECXSTAT)^ SHAD Status (ECXPRIOR or ECXSHADI) ^
;Purple Heart Indicator (ECXPHI)^Period of Service (ECXPOS)^
;Observation Patient Indicator (ECXOBS)^ Encounter Number (ECXENC)^
;Agent Orange Location (ECXAOL)^Production Division Code (ECXPDIV)^ Appointment Type (ECXATYP)^
;Purpose of Visit (ECXPVST)^Means Test (ECXMTST)^Head & Neck Cancer Indicator (ECXHNCI)^
;Placehold Ethnicity(ECXETH)^Placehold Race 1(ECXRC1)^CBOC Status (ECXCBOC)^PLACEHOLD DSS IP #^Enrollment Priority (ECXPRIOR_ECXSBGRP)^
;User Enrollee (ECXUESTA)^ Patient Type(ECXPTYPE)^CV Status Eligibility (ECXCVE)^
;CV Eligibility End Date (ECXCVEDT)^Encounter CV (ECXCVENC)^PLACEHOLD National Patient Record Flag (ECXNPRFI)^
;SW Asia Conditions (ECXEST)^Encounter SWAC (ECXECE)^ERI (ECXERI)^Enc Head/Neck CA (ECXHNC)^
;OEF/OIF (ECXOEF)^ OEF/OIF Return Date (ECXOEFDT)^Placehold Associate PC Provider NPI (ECASNPI)^
;Placehold Primary Care Provider NPI (ECPTNPI)^Provider NPI(ECPRNPI)^
;NODE(3)
;Country Code (ECXCNTRY)^Encounter SHAD (ECXSHAD)^PATCAT (ECXPATCAT)^Secondary Provider #1 (ECSP1)^
;Secondary Provider #1 PC (ECSPPC1)^Secondary Provider #1 NPI (ECSPNPI1)^Secondary Provider #2 (ECSP2)^
;Secondary Provider #2 PC (ECSPPC2)^Secondary Provider #2 NPI (ECSPNPI2)^Secondary Provider #3 (ECSP3)^
;Secondary Provider #3 PC (ECSPPC3)^Secondary Provider #3 NPI (ECSPNPI3)^Secondary Provider #4 (ECSP4)^
;Secondary Provider #4 PC (ECSPPC4)^Secondary Provider #4 NPI (ECSPNPI4)^Secondary Provider #5 (ECSP5)^
;Secondary Provider #5 PC (ECSPPC5)^Secondary Provider #5 NPI (ECSPNPI5)^
;ED Disposition Code (ECXEDIS)^Primary ICD-10 Code (ECXICD10P)^Secondary ICD-10 Code #1 (ECXICD101)^
;Secondary ICD-10 Code #2 (ECXICD102)^Secondary ICD-10 Code #3 (ECXICD103)^Secondary ICD-10 Code #4 (ECXICD104)^
;Encounter SC (ECXESC)^Vietnam (ECXVNS)^Secondary Provider #6 (ECSP6)^Secondary Provider #6 PC (ECSPPC6)^
;Secondary Provider #6 NPI (ECSPNPI6)^
;NODE(4)
;Secondary Provider #7 (ECSP7)^Secondary Provider #7 PC (ECSPPC7)^Secondary Provider #7 NPI (ECSPNPI7)^
;Camp Lejeune Status (ECXCLST)^Encounter Camp Lejeune (ECXECL)^Primary Procedure (ECXPP)
;Combat Service Indicator (ECXSVCI) ^ Combat Service Location (ECXSVCL)^Clinic IEN (ECXCLIN)^
;New Feeder Key (ECXKEY after FY2017)^ Patient Division (ECXSTANO)^
;CPT, Qty & Modifiers #1 (ECXCQM1)^CPT, Qty & Modifiers #2 (ECXCQM2)^CPT, Qty & Modifiers #3 (ECXCQM3)^
;CPT, Qty & Modifiers #4 (ECXCQM4)^CPT, Qty & Modifiers #5 (ECXCQM5)^CPT, Qty & Modifiers #6 (ECXCQM6)
;NODE(5)
;CPT, Qty & Modifiers #7 (ECXCQM7)^CPT, Qty & Modifiers #8 (ECXCQM8)^CPT, Qty & Modifiers #9 (ECXCQM9)^
;CPT, Qty & Modifiers #10 (ECXCQM10)^CPT, Qty & Modifiers #11 (ECXCQM11)^CPT, Qty & Modifiers #12 (ECXCQM12)
;CPT, Qty & Modifiers #13 (ECXCQM13)^CPT, Qty & Modifiers #14 (ECXCQM14)^CPT, Qty & Modifiers #15 (ECXCQM15)^
;CPT, Qty & Modifiers #16 (ECXCQM16)^CPT, Qty & Modifiers #17 (ECXCQM5)^
;NODE(6)
;CPT, Qty & Modifiers #18 (ECXCQM18)^CPT, Qty & Modifiers #19 (ECXCQM19)^CPT, Qty & Modifiers #20 (ECXCQM20)^
;CPT, Qty & Modifiers #21 (ECXCQM21)^CPT, Qty & Modifiers #22 (ECXCQM22)^CPT, Qty & Modifiers #23 (ECXCQM23)
;CPT, Qty & Modifiers #24 (ECXCQM24)^CPT, Qty & Modifiers #25 (ECXCQM25)^
;Service Connected Status (ECXSCST)^Non-count flag (ECXNOCNT)^
;NODE(7) after 2022
;Cerner Data (ECXCERN1)^
;NODE(8) after 2022
;ADMISSION DATE (ECXADMDT) $$ECXDATE^ECXUTL(ECXADMDT,ECXYM)^ADMISSION TIME (ECXADMDT) $$ECXTIME^ECXUTL(ECXADMDT)^Cerner Data2 (ECXCERN2)^
;New MPI (ECXNMPI)^Provider Taxonomy (ECXPRX12)^ Other Sta6a (ECXSTA6)^FEEDER LOCATION (ECXFDLOC)^Placehold CPRS Other Sta6a (ECXCSTA6)^
;Self Identified Gender (ECXSIGI)
;
N STR
N ECXSTANO ;161 tjl
N INST,ECXSTA6A ;184
S ECXPDIV=$$GETDIV^ECXDEPT(ECXDIV) ; Get production division
S ECXSTANO=$$GETDIV^ECXDEPT($$GET1^DIQ(44,ECXCLIN,3.5,"I")) ;166 tjl - Get Patient Division
I $G(ECXASIH) S ECXA="A" ;170
S EC7=$O(^ECX(727.827,999999999),-1),EC7=EC7+1
I ECXLOGIC>2018 D ;170 Fields will now be null
. S (ECXRACE,ECXETH,ECXRC1,ECPTTM,ECPTPR,ECCLAS,ECASPR,ECCLAS2,ECASNPI,ECPTNPI)=""
I ECXLOGIC>2019 S ECXNPRFI="" ;174 - TJL - Field retired
I ECXLOGIC>2020 S ECXMTST="" ;178 Means Test field will now be null
I ECXLOGIC>2022 D ;184
. S ECXMPI="" ;field retired
. S INST=$P(^ECX(728.44,ECXCLIN,0),U,15) ;184
. S ECXSTA6A=$$GET1^DIQ(4,INST,99)
. S ECXFDLOC=$S(ECXSTA6A="":ECXDIV,1:ECXSTA6A_"-")_$E(ECXKEY,1,3) ;184
S STR(0)=EC7_U_EC23_U_ECXDIV_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
S STR(0)=STR(0)_$$ECXDATE^ECXUTL(ECXDATE,ECXYM)_U_$S($G(ECXLOGIC)>2017:"",1:ECXKEY)_U_ECXOBI_U ;166 Feeder key will be here if FY<2018, otherwise it will be null
;convert specialty to PTF Code for transmission
N ECXDATA,ECXTSC
S ECXDATA=$$TSDATA^DGACT(42.4,+ECXTS,.ECXDATA)
S ECXTSC=$G(ECXDATA(7))
;done
S STR(0)=STR(0)_$S(ECXLOGIC>2015:"",1:ECXCLIN)_U_ECXTSC_U_ECXTI_U_ECPTTM_U_ECPTPR_U_ECCLAS_U
S STR(0)=STR(0)_ECXPROV_U_ECXPROVP_U_ECXCPT1_U_ECXCPT2_U_ECXCPT3_U
S STR(0)=STR(0)_ECXCPT4_U_ECXCPT5_U
S STR(1)=ECXCPT6_U_ECXCPT7_U_ECXCPT8_U_ECXICD9P_U_ECXICD91_U_ECXICD92_U
S STR(1)=STR(1)_ECXICD93_U_ECXICD94_U_ECXDOB_U_ECXELIG_U_ECXVET_U
S STR(1)=STR(1)_ECXRACE_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXIR_U_ECXAST_U
S STR(1)=STR(1)_ECXAO_U_ECXMPI_U_ECXDSSD_U_ECXSEX_U_ECXZIP_U
S STR(1)=STR(1)_$G(ECXPCPNP)_U_U_ECXENEL_U_ECXMST_U
S STR(1)=STR(1)_ECXMIL_U_U_U_ECXENRL_U_ECXSTATE_U
S STR(1)=STR(1)_ECXCNTY_U_ECASPR_U_ECCLAS2_U_U_ECXDOM_U_ECXCAT_U
S STR(2)=ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,ECXLOGIC>2010:ECXSHADI,1:"")_U_ECXPHI_U_ECXPOS_U_ECXOBS_U_ECXENC_U
S STR(2)=STR(2)_ECXAOL_U_ECXPDIV_U_ECXATYP_U_ECXPVST_U_ECXMTST_U
S STR(2)=STR(2)_ECXHNCI_U_ECXETH_U_ECXRC1
I ECXLOGIC>2003 S STR(2)=STR(2)_U_ECXCBOC
I ECXLOGIC>2004 S STR(2)=STR(2)_U_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI
I ECXLOGIC>2005 S STR(2)=STR(2)_U_ECXEST_U_ECXECE
I ECXLOGIC>2006 S STR(2)=STR(2)_U_ECXERI_U_ECXHNC
I ECXLOGIC>2007 S STR(2)=STR(2)_U_ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECPTNPI_U_$G(ECPRNPI)_U
I ECXLOGIC>2009 S STR(3)=ECXCNTRY
;added patcat status, N3 P3
I ECXLOGIC>2010 S STR(3)=STR(3)_U_ECXSHAD_U_ECXPATCAT
I ECXLOGIC>2011 S STR(3)=STR(3)_U_ECSP1_U_ECSPPC1_U_ECSPNPI1_U_ECSP2_U_ECSPPC2_U_ECSPNPI2_U_ECSP3_U_ECSPPC3_U_ECSPNPI3_U_ECSP4_U_ECSPPC4_U_ECSPNPI4_U_ECSP5_U_ECSPPC5_U_ECSPNPI5
;added icd-10
I ECXLOGIC>2012 S STR(3)=STR(3)_U_$G(ECXEDIS)_U_ECXICD10P_U_ECXICD101_U_ECXICD102_U_ECXICD103_U_ECXICD104 ;136
I ECXLOGIC>2013 S STR(3)=STR(3)_U_ECXESC_U_ECXVNS_U_ECSP6_U_ECSPPC6_U_ECSPNPI6_U ; 144
I ECXLOGIC>2013 S STR(4)=ECSP7_U_ECSPPC7_U_ECSPNPI7_U_ECXCLST_U_ECXECL ; 144 new provider fields and camp lejeune fields
I ECXLOGIC>2014 S STR(4)=STR(4)_U_$G(ECXPP)_U_ECXSVCI_U_ECXSVCL ;149 add primary procedure, Comb SVC Ind, loc
I ECXLOGIC>2015 S STR(4)=STR(4)_U_ECXCLIN ;154 moved clinic IEN to end of extract
I ECXLOGIC>2017 S STR(4)=STR(4)_U_ECXKEY_U_ECXSTANO ;166 New feeder key, Patient division
I ECXLOGIC>2018 D ;170 tjl - A record now contains up to 25 CPT Codes, Quantities & Modifiers
. S STR(4)=STR(4)_U_ECXCQM1_U_ECXCQM2_U_ECXCQM3_U_ECXCQM4_U_ECXCQM5_U_ECXCQM6_U
. S STR(5)=ECXCQM7_U_ECXCQM8_U_ECXCQM9_U_ECXCQM10_U_ECXCQM11_U_ECXCQM12
. S STR(5)=STR(5)_U_ECXCQM13_U_ECXCQM14_U_ECXCQM15_U_ECXCQM16_U_ECXCQM17_U
. S STR(6)=ECXCQM18_U_ECXCQM19_U_ECXCQM20_U_ECXCQM21_U_ECXCQM22_U_ECXCQM23_U_ECXCQM24_U_ECXCQM25
I ECXLOGIC>2019 S STR(6)=STR(6)_U_ECXSCST_U_$G(ECXNOCNT) ; 174 Add Service Connected Status and non-count flag
I ECXLOGIC=2022 S STR(6)=STR(6)_U_$$ECXDATE^ECXUTL(ECXADMDT,ECXYM)_U_$$ECXTIME^ECXUTL(ECXADMDT)_U ;181 Add Admission Date and Time,184 Adm. Date and Adm Time only for 2022 logic
I ECXLOGIC>2022 D ;184 - Insert Placehold Cerner b4 Adm Date and Adm. Time,Add New MPI, Provider X12,Other Sta6a,Feeder Loc,Self Identified
. S STR(6)=STR(6)_U
. S STR(7)=$G(ECXCERN1)_U
. S STR(8)=$$ECXDATE^ECXUTL(ECXADMDT,ECXYM)_U_$$ECXTIME^ECXUTL(ECXADMDT)_U_$G(ECXCERN2)_U_ECXNMPI_U_ECXPRX12_U_ECXSTA6A_U_ECXFDLOC_U_$G(ECXCSTA6)_U_ECXSIGI
D FILE2^ECXSCX2(727.827,EC7,.STR)
S ECRN=ECRN+1,$P(^ECX(727.827,0),U,3)=EC7
Q
;
SETUP ;set required input for ECXTRAC
S ECHEAD="CLI"
D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXSCXN 18074 printed Dec 13, 2024@01:53:55 Page 2
ECXSCXN ;ALB/JAP Clinic Extract ;Mar 18, 2021@15:55:41
+1 ;;3.0;DSS EXTRACTS;**24,27,29,30,31,32,33,39,46,49,52,71,84,92,107,105,120,124,127,132,136,144,149,156,154,161,166,170,174,178,181,184**;Dec 22, 1997;Build 124
+2 ;
+3 ; Reference to ^DIC(4) in ICR #10090
+4 ; Reference to ^SC in ICR #10040
+5 ;
BEG ;entry point from option
+1 DO SETUP
if ECFILE=""
QUIT
DO ^ECXTRAC
DO ^ECXKILL
+2 QUIT
+3 ;
START ;entry point from taskmgr
+1 ;166
NEW DIC,EXNUM,I,LOCARR,OUT,P1,P2,P3,P4,PROCESS,SOURCE,STOP,STAT,TOSEND
+2 ;184 Added DSIPIEN,DSITIEN
NEW TIU,X,Y,ECXNPRFI,DSIPIEN,DSITIEN
+3 NEW ECXICD10P,ECXICD101,ECXICD102,ECXICD103,ECXICD104
+4 FOR I=1:1:8
SET @("ECXCPT"_I)=""
+5 FOR I=1:1:4
SET @("ECXICD9"_I)=""
+6 FOR I=1:1:4
SET @("ECXICD10"_I)=""
+7 ;170 - initialize the 25 new CPT variables
FOR I=1:1:25
SET @("ECXCQM"_I)=""
+8 SET (OUT,QFLG,ECRN)=0
SET (ECXICD9P,ECXOBI,ECXICD10P)=""
+9 ;136
KILL ^TMP($JOB,"ECXS"),^TMP($JOB,"ECXCL"),^TMP($JOB,"SDAMA301")
+10 ;get ien for tiu in file #839.7
+11 SET DIC="^PX(839.7,"
SET DIC(0)="X"
SET X="TEXT INTEGRATION UTILITIES"
+12 DO ^DIC
SET TIU=+Y
SET ECED=ECED+.3
SET ECXCLIN=0
KILL DIC,Y
+13 SET DIC="^PX(839.7,"
SET DIC(0)="X"
SET X="DSIP DSS PCE"
+14 DO ^DIC
SET DSIPIEN=+Y
KILL DIC,Y
+15 SET DIC="^PX(839.7,"
SET DIC(0)="X"
SET X="DSIT DSS PCE"
+16 DO ^DIC
SET DSITIEN=+Y
KILL DIC,Y
+17 ;get clinic default appt length, type, division
+18 FOR
SET ECXCLIN=$ORDER(^SC(ECXCLIN))
if 'ECXCLIN
QUIT
Begin DoDot:1
+19 ;174 Added 2502, non-count field
KILL LOCARR
SET DIC=44
SET DA=ECXCLIN
SET DR="2;3.5;1912;2502"
SET DIQ(0)="I"
SET DIQ="LOCARR"
+20 DO EN^DIQ1
+21 if $GET(LOCARR(44,ECXCLIN,2,"I"))'="C"
QUIT
+22 SET ALEN=+$GET(LOCARR(44,ECXCLIN,1912,"I"))
+23 SET ^TMP($JOB,"ECXCL",ECXCLIN)=ALEN
SET ALEN=$$RJ^XLFSTR(ALEN,3,0)
+24 ;174 Set non-count flag
SET ^TMP($JOB,"ECXCL",ECXCLIN)=^TMP($JOB,"ECXCL",ECXCLIN)_"^"_ALEN_"^"_$GET(LOCARR(44,ECXCLIN,2,"I"))_"^"_+$GET(LOCARR(44,ECXCLIN,3.5,"I"))_"^"_$SELECT($GET(LOCARR(44,ECXCLIN,2502,"I"))="Y":"Y",1:"")
+25 ;166
DO FEEDER^ECXSCX1(ECXCLIN,ECSD1,.P1,.P2,.P3,.TOSEND,.ECXDIV,.P4)
+26 ;166
KILL P1,P2,P3,P4,TOSEND,ECXDIV
End DoDot:1
+27 ;get from file #44 any no-shows & get encounters from #409.68
+28 DO NOSHOW^ECXSCXN1(ECSD1,ECED)
DO ENCNTR(ECSD1,ECED)
+29 ;send missing clinic msg
+30 if $DATA(^TMP($JOB,"ECXS"))
DO EN^ECXSCX1
+31 ;136
KILL ^TMP($JOB,"ECXS"),^TMP($JOB,"ECXCL"),^TMP($JOB,"SDAMA301")
+32 QUIT
+33 ;
ENCNTR(ECSD1,ECED) ;search file #409.68 for encounter data
+1 ;136
NEW CHKOUT,ECD,STAT,STOP,MDIV,ECXEDIS,CNT,ECXARR,NODE
+2 ;149,170,174
NEW ECXESC,ECXECL,ECXCLST,ECXPP,ECXASIH,ECXSCST,ECXNOCNT
+3 ;184
NEW ECXNMPI,ECXSTA6,ECXPRX12,ECXCERN1,ECXCERN2,ECXSIGI,ECXCSTA6
+4 ;184
SET (ECXCERN1,ECXCERN2,ECXCSTA6)=""
+5 SET ECD=ECSD1
+6 FOR
SET ECD=$ORDER(^SCE("B",ECD))
if ('ECD!(ECD>ECED))!(QFLG)
QUIT
SET ECXIEN=0
Begin DoDot:1
+7 FOR
SET ECXIEN=$ORDER(^SCE("B",ECD,ECXIEN))
if 'ECXIEN
QUIT
Begin DoDot:2
+8 if '$DATA(^SCE(ECXIEN,0))
QUIT
+9 DO INTPAT^ECXSCX2
KILL LOCARR
SET DIC=409.68
SET DA=ECXIEN
+10 SET DR=".01;.02;.03;.04;.05;.06;.07;.08;.11;.12;.13"
SET DIQ(0)="I"
SET DIQ="LOCARR"
+11 DO EN^DIQ1
+12 ;166
SET ECXTI=$$ECXTIME^ECXUTL(+$GET(LOCARR(409.68,ECXIEN,.01,"I")))
+13 ;166
SET MDIV=+$GET(LOCARR(409.68,ECXIEN,.11,"I"))
+14 SET STOP=+$GET(LOCARR(409.68,ECXIEN,.03,"I"))
+15 SET CHKOUT=+$GET(LOCARR(409.68,ECXIEN,.07,"I"))
+16 SET PROCESS=+$GET(LOCARR(409.68,ECXIEN,.08,"I"))
+17 SET STAT=$GET(LOCARR(409.68,ECXIEN,.12,"I"))
+18 SET ECXDFN=+$GET(LOCARR(409.68,ECXIEN,.02,"I"))
+19 if (ECXDFN=0)!('CHKOUT)
QUIT
+20 if STAT=""
SET STAT="ZZ"
SET STAT=";"_STAT_";"
+21 if ";3;4;5;6;7;9;10;13;"[STAT
QUIT
+22 if ('STOP)!(PROCESS=4)!(+$GET(LOCARR(409.68,ECXIEN,.06,"I")))
QUIT
+23 SET ECXDATE=+$GET(LOCARR(409.68,ECXIEN,.01,"I"))
+24 SET ECXCLIN=+$GET(LOCARR(409.68,ECXIEN,.04,"I"))
+25 if $PIECE($GET(^TMP($JOB,"ECXCL",ECXCLIN)),U,3)'="C"
QUIT
+26 SET ECXVISIT=+$GET(LOCARR(409.68,ECXIEN,.05,"I"))
+27 SET ECXENEL=+$GET(LOCARR(409.68,ECXIEN,.13,"I"))
+28 if 'ECXVISIT
QUIT
+29 SET ECXERR=0
+30 DO PAT1^ECXSCX2(ECXDFN,ECXDATE,.ECXERR)
if ECXERR
QUIT
+31 ;184
IF ECXLOGIC>2022
SET ECXNMPI=ECXMPI
+32 ;166
DO FEEDER^ECXSCX1(ECXCLIN,ECSD1,.P1,.P2,.P3,.TOSEND,.ECXDIV,.P4)
+33 if TOSEND=6
QUIT
+34 ;174 Get non-count flag
SET ECXNOCNT=$PIECE($GET(^TMP($JOB,"ECXCL",ECXCLIN)),U,5)
+35 KILL LOCARR
SET DIC=40.7
SET DA=STOP
SET DR="1"
SET DIQ(0)="I"
SET DIQ="LOCARR"
DO EN^DIQ1
+36 SET ECXSTOP=$$RJ^XLFSTR($GET(LOCARR(40.7,STOP,1,"I")),3,0)
+37 ; ******* - PATCH 127, ADD PATCAT CODE ********
+38 SET ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN)
+39 ;get date specific patient data
+40 DO PAT2^ECXSCX2(ECXDFN,ECXDATE)
+41 ;get national patient record flag if exist
+42 DO NPRF^ECXUTL5
+43 ;get visit specific data
+44 SET ECXERR=0
DO VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR)
if ECXERR
QUIT
+45 ;170 Eight CPT Codes prior to FY19
IF ECXLOGIC<2019
Begin DoDot:3
+46 FOR I=1:1:8
SET @("ECXCPT"_I)=$GET(ECXVIST("CPT"_I))
End DoDot:3
+47 ;170 Twenty-five CPT Codes starting in FY19
IF ECXLOGIC>2018
Begin DoDot:3
+48 FOR I=1:1:25
SET @("ECXCQM"_I)=$GET(ECXVIST("CPT"_I))
End DoDot:3
+49 ;149 Get primary procedure if available
SET ECXPP=$GET(ECXVIST("PRIMPROC"))
+50 ;161
FOR I="P",1:1:4
SET @("ECXICD10"_I)=ECXVIST("ICD9"_I)
+51 SET SOURCE=ECXVIST("SOURCE")
SET ECXAO=ECXVIST("AO")
SET ECXIR=ECXVIST("IR")
+52 SET ECXMIL=ECXVIST("MST")
SET ECXPROV=ECXVIST("PROV")
SET ECXSHAD=ECXVIST("SHAD")
+53 ;144
SET ECXECL=ECXVIST("ENCCL")
SET ECXESC=ECXVIST("ENCSC")
+54 SET ECPRNPI=$$NPI^XUSNPI("Individual_ID",ECXPROV,ECXDATE)
+55 if +ECPRNPI'>0
SET ECPRNPI=""
SET ECPRNPI=$PIECE(ECPRNPI,U)
+56 SET ECXPROVP=ECXVIST("PROV CLASS")
SET ECXPROVN=ECXVIST("PROV NPI")
+57 ;184
SET ECXPRX12=ECXVIST("PROV X12")
+58 ;144 2 new prov
FOR I=1:1:7
SET @("ECSP"_I)=$PIECE($GET(ECXVIST("PROVS"_I)),U)
+59 ;144 2 new person class
FOR I=1:1:7
SET @("ECSPPC"_I)=$PIECE($GET(ECXVIST("PROVS"_I)),U,2)
+60 ;144 2 new NPI
FOR I=1:1:7
SET @("ECSPNPI"_I)=$PIECE($GET(ECXVIST("PROVS"_I)),U,3)
+61 SET ECXECE=ECXVIST("PGE")
SET ECXHNC=ECXVIST("HNC")
+62 KILL LOCARR
SET DIC=8
SET DA=ECXENEL
SET DR="8"
SET DIQ(0)="I"
SET DIQ="LOCARR"
DO EN^DIQ1
+63 SET ECXENEL=+$GET(LOCARR(8,ECXENEL,8,"I"))
+64 if ECXENEL
SET ECXENEL=$$ELIG^ECXUTL3(ECXENEL,ECXSVC)
+65 ;is cboc facility?
SET ECXCBOC=$SELECT(MDIV'="":$$CBOC^ECXSCX2(.MDIV),1:"")
+66 ;136 Set emergency room disposition
SET ECXEDIS=$$EDIS^ECXUTL1(ECXDFN,ECD,"C",ECXVISIT,ECXSTOP)
+67 ;setup feeder key and file in extract records
+68 SET (ECXKEY,ECXDSSD)=""
+69 ;appointments
+70 ;get appt length 136 Section changed to use SDAMA301 call
IF PROCESS=1
Begin DoDot:3
+71 NEW CNT,ECXARR
+72 KILL ^TMP($JOB,"SDAMA301")
+73 SET ECXARR(1)=ECXDATE_";"_ECXDATE
SET ECXARR(2)=ECXCLIN
SET ECXARR(4)=ECXDFN
SET ECXARR("FLDS")="5;7;10;18"
SET CNT=$$SDAPI^SDAMA301(.ECXARR)
+74 ;Stop if no appts (CNT=0) send error message and stop extract if CNT=-1 (system error)
if CNT=0
QUIT
IF CNT=-1
DO ERR^ECXUTL1
SET QFLG=1
QUIT
+75 SET NODE=^TMP($JOB,"SDAMA301",ECXDFN,ECXCLIN,ECXDATE)
+76 ;convert overbook indicator from Y to O otherwise send null
SET ECXOBI=$SELECT($PIECE(NODE,U,7)="Y":"O",1:"")
+77 SET ALEN=$$RJ^XLFSTR($PIECE(NODE,U,5),3,0)
+78 ;156-modified global ref to "ECXCL"
if +ALEN=0
SET ALEN=$PIECE($GET(^TMP($JOB,"ECXCL",ECXCLIN)),U,2)
+79 SET ECXSTOP=P1
+80 SET ECXPVST=+$PIECE(NODE,U,18)
SET ECXATYP=+$PIECE(NODE,U,10)
+81 IF TOSEND'=3
Begin DoDot:4
+82 ;166
SET ECXKEY=P1_P2_ALEN_P3_"0"_P4
SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY)
+83 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,)
if ECXENC'=""
DO FILE
End DoDot:4
+84 IF TOSEND=3
Begin DoDot:4
+85 ;166
SET ECXKEY=P1_"000"_ALEN_P3_"0"_P4
SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY)
+86 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,)
if ECXENC'=""
DO FILE
End DoDot:4
+87 IF TOSEND=3
Begin DoDot:4
+88 ;166
SET ECXKEY=P2_"000"_ALEN_P3_"0"_P4
SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY)
+89 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,)
if ECXENC'=""
DO FILE
End DoDot:4
End DoDot:3
QUIT
+90 IF PROCESS=2
Begin DoDot:3
+91 SET ALEN=0
+92 IF SOURCE=TIU
SET ALEN=$PIECE($GET(^TMP($JOB,"ECXCL",ECXCLIN)),U,2)
+93 ;184
IF ECXLOGIC>2022
Begin DoDot:4
+94 ;184
IF SOURCE=DSIPIEN
SET ALEN=$PIECE($GET(^TMP($JOB,"ECXCL",ECXCLIN)),U,2)
+95 ;184
IF SOURCE=DSITIEN
SET ALEN=$PIECE($GET(^TMP($JOB,"ECXCL",ECXCLIN)),U,2)
End DoDot:4
+96 ;166
if +ALEN=0
SET ALEN="030"
SET ECXKEY=P1_P2_ALEN_P3_"0"_P4
SET ECXSTOP=P1
+97 SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY)
+98 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,)
if ECXENC'=""
DO FILE
End DoDot:3
QUIT
+99 ;dispositions
+100 IF PROCESS=3
Begin DoDot:3
+101 ;166,170
SET ECXKEY=ECXSTOP_"00006000000"_P4
SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY)
+102 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,)
if ECXENC'=""
DO FILE
End DoDot:3
QUIT
End DoDot:2
if QFLG
QUIT
End DoDot:1
+103 QUIT
+104 ;
FILE ;record setup for file #727.827
+1 ;NODE(0)
+2 ;Sequence Number,Year Month, Extract Number (EC23)^facility (ECXDIV)^
+3 ;dfn (ECXDFN)^ssn (ECXSSN)^name (ECXPNM)^
+4 ;in/out (ECXA)^Day $$ECXDATE^ECXUTL(ECXDATE,ECXYM)^Placehold Feeder Key (FY<2018) (ECXKEY) ^
+5 ;Overbooked Indicator (ECXOBI)^Clinic Name (NOW NULL)^Treating Specialty (ECXTSC) ^
+6 ;Time (ECXTI)^Placehold Primary Care Team (ECPTTM)^Placehold primary care provider(ECPTPR)^
+7 ;Placehold Primary Care PRV Person Class(ECCLAS)^Provider (ECXPROV)^
+8 ;provider person class (ECPROVP)^Placehold CPT Qty & Mods #1 (ECXCPT1)^
+9 ;Placehold CPT Qty & Mods #2 (ECXCPT2)^Placehold CPT Qty & Mods #3 (ECXCPT3)^
+10 ;Placehold CPT Qty & Mods #4 (ECXCPT4)^Placehold CPT Qty & Mods #5 (ECXCPT5)^
+11 ;NODE(1)
+12 ;Placehold CPT Qty & Mods #6 (ECXCPT6)^Placehold CPT Qty & Mods #7 (ECXCPT7)^
+13 ;Placehold CPT Qty & Mods #8 (ECXCPT8)^Placeholder (ECXICD9P)^
+14 ;Placeholder (ECXICD91)^Placeholder (ECXICD92)
+15 ;Placeholder (ECXICD93)^Placeholder (ECXICD94)
+16 ;date of birth (ECDOB)^Eligibility (ECXELIG)^Veteran (ECXVET)^
+17 ;Placehold Race (ECXRACE)^POW status (ECXPST)^POW Location (ECXPLOC)^ Radiation Status(ECXRST)^
+18 ;Radiation Encounter Indicator (ECXIR)^Agent Orange Status (ECXAST)^
+19 ;Agent Orange Location(ECXAO)^Master Patient Index ((ECXMPI)^PLACEHOLD DSS Product Department (ECXDSSD)^
+20 ;Sex (ECXSEX)^zip code (ECXZIP)^Place Holder^Place Holder^Encounter Eligibility (ECXENEL)^
+21 ;MST Status(ECXMST)^MST Encounter Indicator (ECXMIL)^PLACEHOLD Sharing Payor^PLACEHOLD Sharing Ins^
+22 ;Enrollment Location ((ECXENRL)^State (ECXSTATE)^County (ECXCNTY)^
+23 ;Placehold Associate PC Provider (ECASPR)^Placehold Associate PC Prov. Person Class (ECCLAS2)^Place Holder^
+24 ;DOM, PRRTP AND SAARTP Indicator (ECXDOM)^ Enrollment Category (ECXCAT)^
+25 ;NODE(2)
+26 ;Enrollment Status (ECXSTAT)^ SHAD Status (ECXPRIOR or ECXSHADI) ^
+27 ;Purple Heart Indicator (ECXPHI)^Period of Service (ECXPOS)^
+28 ;Observation Patient Indicator (ECXOBS)^ Encounter Number (ECXENC)^
+29 ;Agent Orange Location (ECXAOL)^Production Division Code (ECXPDIV)^ Appointment Type (ECXATYP)^
+30 ;Purpose of Visit (ECXPVST)^Means Test (ECXMTST)^Head & Neck Cancer Indicator (ECXHNCI)^
+31 ;Placehold Ethnicity(ECXETH)^Placehold Race 1(ECXRC1)^CBOC Status (ECXCBOC)^PLACEHOLD DSS IP #^Enrollment Priority (ECXPRIOR_ECXSBGRP)^
+32 ;User Enrollee (ECXUESTA)^ Patient Type(ECXPTYPE)^CV Status Eligibility (ECXCVE)^
+33 ;CV Eligibility End Date (ECXCVEDT)^Encounter CV (ECXCVENC)^PLACEHOLD National Patient Record Flag (ECXNPRFI)^
+34 ;SW Asia Conditions (ECXEST)^Encounter SWAC (ECXECE)^ERI (ECXERI)^Enc Head/Neck CA (ECXHNC)^
+35 ;OEF/OIF (ECXOEF)^ OEF/OIF Return Date (ECXOEFDT)^Placehold Associate PC Provider NPI (ECASNPI)^
+36 ;Placehold Primary Care Provider NPI (ECPTNPI)^Provider NPI(ECPRNPI)^
+37 ;NODE(3)
+38 ;Country Code (ECXCNTRY)^Encounter SHAD (ECXSHAD)^PATCAT (ECXPATCAT)^Secondary Provider #1 (ECSP1)^
+39 ;Secondary Provider #1 PC (ECSPPC1)^Secondary Provider #1 NPI (ECSPNPI1)^Secondary Provider #2 (ECSP2)^
+40 ;Secondary Provider #2 PC (ECSPPC2)^Secondary Provider #2 NPI (ECSPNPI2)^Secondary Provider #3 (ECSP3)^
+41 ;Secondary Provider #3 PC (ECSPPC3)^Secondary Provider #3 NPI (ECSPNPI3)^Secondary Provider #4 (ECSP4)^
+42 ;Secondary Provider #4 PC (ECSPPC4)^Secondary Provider #4 NPI (ECSPNPI4)^Secondary Provider #5 (ECSP5)^
+43 ;Secondary Provider #5 PC (ECSPPC5)^Secondary Provider #5 NPI (ECSPNPI5)^
+44 ;ED Disposition Code (ECXEDIS)^Primary ICD-10 Code (ECXICD10P)^Secondary ICD-10 Code #1 (ECXICD101)^
+45 ;Secondary ICD-10 Code #2 (ECXICD102)^Secondary ICD-10 Code #3 (ECXICD103)^Secondary ICD-10 Code #4 (ECXICD104)^
+46 ;Encounter SC (ECXESC)^Vietnam (ECXVNS)^Secondary Provider #6 (ECSP6)^Secondary Provider #6 PC (ECSPPC6)^
+47 ;Secondary Provider #6 NPI (ECSPNPI6)^
+48 ;NODE(4)
+49 ;Secondary Provider #7 (ECSP7)^Secondary Provider #7 PC (ECSPPC7)^Secondary Provider #7 NPI (ECSPNPI7)^
+50 ;Camp Lejeune Status (ECXCLST)^Encounter Camp Lejeune (ECXECL)^Primary Procedure (ECXPP)
+51 ;Combat Service Indicator (ECXSVCI) ^ Combat Service Location (ECXSVCL)^Clinic IEN (ECXCLIN)^
+52 ;New Feeder Key (ECXKEY after FY2017)^ Patient Division (ECXSTANO)^
+53 ;CPT, Qty & Modifiers #1 (ECXCQM1)^CPT, Qty & Modifiers #2 (ECXCQM2)^CPT, Qty & Modifiers #3 (ECXCQM3)^
+54 ;CPT, Qty & Modifiers #4 (ECXCQM4)^CPT, Qty & Modifiers #5 (ECXCQM5)^CPT, Qty & Modifiers #6 (ECXCQM6)
+55 ;NODE(5)
+56 ;CPT, Qty & Modifiers #7 (ECXCQM7)^CPT, Qty & Modifiers #8 (ECXCQM8)^CPT, Qty & Modifiers #9 (ECXCQM9)^
+57 ;CPT, Qty & Modifiers #10 (ECXCQM10)^CPT, Qty & Modifiers #11 (ECXCQM11)^CPT, Qty & Modifiers #12 (ECXCQM12)
+58 ;CPT, Qty & Modifiers #13 (ECXCQM13)^CPT, Qty & Modifiers #14 (ECXCQM14)^CPT, Qty & Modifiers #15 (ECXCQM15)^
+59 ;CPT, Qty & Modifiers #16 (ECXCQM16)^CPT, Qty & Modifiers #17 (ECXCQM5)^
+60 ;NODE(6)
+61 ;CPT, Qty & Modifiers #18 (ECXCQM18)^CPT, Qty & Modifiers #19 (ECXCQM19)^CPT, Qty & Modifiers #20 (ECXCQM20)^
+62 ;CPT, Qty & Modifiers #21 (ECXCQM21)^CPT, Qty & Modifiers #22 (ECXCQM22)^CPT, Qty & Modifiers #23 (ECXCQM23)
+63 ;CPT, Qty & Modifiers #24 (ECXCQM24)^CPT, Qty & Modifiers #25 (ECXCQM25)^
+64 ;Service Connected Status (ECXSCST)^Non-count flag (ECXNOCNT)^
+65 ;NODE(7) after 2022
+66 ;Cerner Data (ECXCERN1)^
+67 ;NODE(8) after 2022
+68 ;ADMISSION DATE (ECXADMDT) $$ECXDATE^ECXUTL(ECXADMDT,ECXYM)^ADMISSION TIME (ECXADMDT) $$ECXTIME^ECXUTL(ECXADMDT)^Cerner Data2 (ECXCERN2)^
+69 ;New MPI (ECXNMPI)^Provider Taxonomy (ECXPRX12)^ Other Sta6a (ECXSTA6)^FEEDER LOCATION (ECXFDLOC)^Placehold CPRS Other Sta6a (ECXCSTA6)^
+70 ;Self Identified Gender (ECXSIGI)
+71 ;
+72 NEW STR
+73 ;161 tjl
NEW ECXSTANO
+74 ;184
NEW INST,ECXSTA6A
+75 ; Get production division
SET ECXPDIV=$$GETDIV^ECXDEPT(ECXDIV)
+76 ;166 tjl - Get Patient Division
SET ECXSTANO=$$GETDIV^ECXDEPT($$GET1^DIQ(44,ECXCLIN,3.5,"I"))
+77 ;170
IF $GET(ECXASIH)
SET ECXA="A"
+78 SET EC7=$ORDER(^ECX(727.827,999999999),-1)
SET EC7=EC7+1
+79 ;170 Fields will now be null
IF ECXLOGIC>2018
Begin DoDot:1
+80 SET (ECXRACE,ECXETH,ECXRC1,ECPTTM,ECPTPR,ECCLAS,ECASPR,ECCLAS2,ECASNPI,ECPTNPI)=""
End DoDot:1
+81 ;174 - TJL - Field retired
IF ECXLOGIC>2019
SET ECXNPRFI=""
+82 ;178 Means Test field will now be null
IF ECXLOGIC>2020
SET ECXMTST=""
+83 ;184
IF ECXLOGIC>2022
Begin DoDot:1
+84 ;field retired
SET ECXMPI=""
+85 ;184
SET INST=$PIECE(^ECX(728.44,ECXCLIN,0),U,15)
+86 SET ECXSTA6A=$$GET1^DIQ(4,INST,99)
+87 ;184
SET ECXFDLOC=$SELECT(ECXSTA6A="":ECXDIV,1:ECXSTA6A_"-")_$EXTRACT(ECXKEY,1,3)
End DoDot:1
+88 SET STR(0)=EC7_U_EC23_U_ECXDIV_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
+89 ;166 Feeder key will be here if FY<2018, otherwise it will be null
SET STR(0)=STR(0)_$$ECXDATE^ECXUTL(ECXDATE,ECXYM)_U_$SELECT($GET(ECXLOGIC)>2017:"",1:ECXKEY)_U_ECXOBI_U
+90 ;convert specialty to PTF Code for transmission
+91 NEW ECXDATA,ECXTSC
+92 SET ECXDATA=$$TSDATA^DGACT(42.4,+ECXTS,.ECXDATA)
+93 SET ECXTSC=$GET(ECXDATA(7))
+94 ;done
+95 SET STR(0)=STR(0)_$SELECT(ECXLOGIC>2015:"",1:ECXCLIN)_U_ECXTSC_U_ECXTI_U_ECPTTM_U_ECPTPR_U_ECCLAS_U
+96 SET STR(0)=STR(0)_ECXPROV_U_ECXPROVP_U_ECXCPT1_U_ECXCPT2_U_ECXCPT3_U
+97 SET STR(0)=STR(0)_ECXCPT4_U_ECXCPT5_U
+98 SET STR(1)=ECXCPT6_U_ECXCPT7_U_ECXCPT8_U_ECXICD9P_U_ECXICD91_U_ECXICD92_U
+99 SET STR(1)=STR(1)_ECXICD93_U_ECXICD94_U_ECXDOB_U_ECXELIG_U_ECXVET_U
+100 SET STR(1)=STR(1)_ECXRACE_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXIR_U_ECXAST_U
+101 SET STR(1)=STR(1)_ECXAO_U_ECXMPI_U_ECXDSSD_U_ECXSEX_U_ECXZIP_U
+102 SET STR(1)=STR(1)_$GET(ECXPCPNP)_U_U_ECXENEL_U_ECXMST_U
+103 SET STR(1)=STR(1)_ECXMIL_U_U_U_ECXENRL_U_ECXSTATE_U
+104 SET STR(1)=STR(1)_ECXCNTY_U_ECASPR_U_ECCLAS2_U_U_ECXDOM_U_ECXCAT_U
+105 SET STR(2)=ECXSTAT_U_$SELECT(ECXLOGIC<2005:ECXPRIOR,ECXLOGIC>2010:ECXSHADI,1:"")_U_ECXPHI_U_ECXPOS_U_ECXOBS_U_ECXENC_U
+106 SET STR(2)=STR(2)_ECXAOL_U_ECXPDIV_U_ECXATYP_U_ECXPVST_U_ECXMTST_U
+107 SET STR(2)=STR(2)_ECXHNCI_U_ECXETH_U_ECXRC1
+108 IF ECXLOGIC>2003
SET STR(2)=STR(2)_U_ECXCBOC
+109 IF ECXLOGIC>2004
SET STR(2)=STR(2)_U_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI
+110 IF ECXLOGIC>2005
SET STR(2)=STR(2)_U_ECXEST_U_ECXECE
+111 IF ECXLOGIC>2006
SET STR(2)=STR(2)_U_ECXERI_U_ECXHNC
+112 IF ECXLOGIC>2007
SET STR(2)=STR(2)_U_ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECPTNPI_U_$GET(ECPRNPI)_U
+113 IF ECXLOGIC>2009
SET STR(3)=ECXCNTRY
+114 ;added patcat status, N3 P3
+115 IF ECXLOGIC>2010
SET STR(3)=STR(3)_U_ECXSHAD_U_ECXPATCAT
+116 IF ECXLOGIC>2011
SET STR(3)=STR(3)_U_ECSP1_U_ECSPPC1_U_ECSPNPI1_U_ECSP2_U_ECSPPC2_U_ECSPNPI2_U_ECSP3_U_ECSPPC3_U_ECSPNPI3_U_ECSP4_U_ECSPPC4_U_ECSPNPI4_U_ECSP5_U_ECSPPC5_U_ECSPNPI5
+117 ;added icd-10
+118 ;136
IF ECXLOGIC>2012
SET STR(3)=STR(3)_U_$GET(ECXEDIS)_U_ECXICD10P_U_ECXICD101_U_ECXICD102_U_ECXICD103_U_ECXICD104
+119 ; 144
IF ECXLOGIC>2013
SET STR(3)=STR(3)_U_ECXESC_U_ECXVNS_U_ECSP6_U_ECSPPC6_U_ECSPNPI6_U
+120 ; 144 new provider fields and camp lejeune fields
IF ECXLOGIC>2013
SET STR(4)=ECSP7_U_ECSPPC7_U_ECSPNPI7_U_ECXCLST_U_ECXECL
+121 ;149 add primary procedure, Comb SVC Ind, loc
IF ECXLOGIC>2014
SET STR(4)=STR(4)_U_$GET(ECXPP)_U_ECXSVCI_U_ECXSVCL
+122 ;154 moved clinic IEN to end of extract
IF ECXLOGIC>2015
SET STR(4)=STR(4)_U_ECXCLIN
+123 ;166 New feeder key, Patient division
IF ECXLOGIC>2017
SET STR(4)=STR(4)_U_ECXKEY_U_ECXSTANO
+124 ;170 tjl - A record now contains up to 25 CPT Codes, Quantities & Modifiers
IF ECXLOGIC>2018
Begin DoDot:1
+125 SET STR(4)=STR(4)_U_ECXCQM1_U_ECXCQM2_U_ECXCQM3_U_ECXCQM4_U_ECXCQM5_U_ECXCQM6_U
+126 SET STR(5)=ECXCQM7_U_ECXCQM8_U_ECXCQM9_U_ECXCQM10_U_ECXCQM11_U_ECXCQM12
+127 SET STR(5)=STR(5)_U_ECXCQM13_U_ECXCQM14_U_ECXCQM15_U_ECXCQM16_U_ECXCQM17_U
+128 SET STR(6)=ECXCQM18_U_ECXCQM19_U_ECXCQM20_U_ECXCQM21_U_ECXCQM22_U_ECXCQM23_U_ECXCQM24_U_ECXCQM25
End DoDot:1
+129 ; 174 Add Service Connected Status and non-count flag
IF ECXLOGIC>2019
SET STR(6)=STR(6)_U_ECXSCST_U_$GET(ECXNOCNT)
+130 ;181 Add Admission Date and Time,184 Adm. Date and Adm Time only for 2022 logic
IF ECXLOGIC=2022
SET STR(6)=STR(6)_U_$$ECXDATE^ECXUTL(ECXADMDT,ECXYM)_U_$$ECXTIME^ECXUTL(ECXADMDT)_U
+131 ;184 - Insert Placehold Cerner b4 Adm Date and Adm. Time,Add New MPI, Provider X12,Other Sta6a,Feeder Loc,Self Identified
IF ECXLOGIC>2022
Begin DoDot:1
+132 SET STR(6)=STR(6)_U
+133 SET STR(7)=$GET(ECXCERN1)_U
+134 SET STR(8)=$$ECXDATE^ECXUTL(ECXADMDT,ECXYM)_U_$$ECXTIME^ECXUTL(ECXADMDT)_U_$GET(ECXCERN2)_U_ECXNMPI_U_ECXPRX12_U_ECXSTA6A_U_ECXFDLOC_U_$GET(ECXCSTA6)_U_ECXSIGI
End DoDot:1
+135 DO FILE2^ECXSCX2(727.827,EC7,.STR)
+136 SET ECRN=ECRN+1
SET $PIECE(^ECX(727.827,0),U,3)=EC7
+137 QUIT
+138 ;
SETUP ;set required input for ECXTRAC
+1 SET ECHEAD="CLI"
+2 DO ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
+3 QUIT
