ECXSCXN.m

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 ---ECXSCXN   18074     printed  Mar 13, 2025@20:58:35                                                                                                                                                                                                    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,)