ECXSCX2 ;ALB/ESD DSS Clinic Extract Utilities (continued) ;1/30/19 15:36
;;3.0;DSS EXTRACTS;**39,46,49,71,84,92,105,120,127,144,149,170,174,184**;Dec 22, 1997;Build 124
;
;
INTPAT ;initialize patient variables
S (ECXSSN,ECXPNM,ECPTPR,ECCLAS,ECPTNPI,ECASPR,ECCLAS2,ECASNPI,ECXZIP)=""
S (ECPTTM,ECXVET,ECXRACE,ECXENRL,ECXMPI,ECXSEX,ECXVNS)=""
S (ECXDOB,ECXELIG,ECXPST,ECXPLOC,ECXRST,ECXAST,ECXMST,ECXSTATE)=""
S (ECXCNTY,ECXCNTRY,ECXATYP,ECXPVST,ECXMTST,ECXEST,ECXECE,ECXHNC)=""
S (ECXESC,ECXECL,ECXCLST,ECXSVCI,ECXSVCL)="" ;149
S (ECXSIGI,ECXSTA6,ECXNMPI,ECXCSTA,ECXCERN1,ECXCERN2)="" ;184
Q
;
PAT1(ECXDFN,ECXDATE,ECXERR) ;get patient demographic data
N ECXPAT,K,OK,X
S ECXERR=0
S OK=$$PAT^ECXUTL3(ECXDFN,$P(ECXDATE,"."),"1;2;3;4;5",.ECXPAT)
I 'OK S ECXERR=1 Q
S ECXSSN=ECXPAT("SSN"),ECXPNM=ECXPAT("NAME"),ECXMPI=ECXPAT("MPI")
S ECXSEX=ECXPAT("SEX"),ECXDOB=ECXPAT("DOB"),ECXELIG=ECXPAT("ELIG")
S ECXVET=ECXPAT("VET"),ECXSVC=ECXPAT("SC%"),ECXRACE=ECXPAT("RACE")
S ECXPST=ECXPAT("POW STAT"),ECXPLOC=ECXPAT("POW LOC")
S ECXRST=ECXPAT("IR STAT"),ECXAST=ECXPAT("AO STAT")
S ECXMST=ECXPAT("MST STAT"),ECXSTATE=ECXPAT("STATE")
S ECXCNTY=ECXPAT("COUNTY"),ECXZIP=ECXPAT("ZIP")
S ECXCNTRY=ECXPAT("COUNTRY")
S ECXENRL=ECXPAT("ENROLL LOC"),ECXMTST=ECXPAT("MEANS")
S ECXSIGI=ECXPAT("SIGI") ;184 Self Idenfied Gender
; changes for 2001
S ECXPOS=ECXPAT("POS"),ECXPHI=ECXPAT("PHI")
;- Agent Orange location
S ECXAOL=ECXPAT("AOL")
;OEF/OIF data
S ECXOEF=ECXPAT("ECXOEF")
S ECXOEFDT=ECXPAT("ECXOEFDT")
I $$ENROLLM^ECXUTL2(ECXDFN)
; - Head and Neck Cancer Indicator
S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
; - PROJ 112/SHAD Indicator
S ECXSHADI=$$SHAD^ECXUTL4(ECXDFN)
; - Race and Ethnicity
S ECXETH=ECXPAT("ETHNIC")
S ECXRC1=ECXPAT("RACE1")
; - Environmental Contaminants
S ECXEST=ECXPAT("EC STAT")
;get emergency response indicator (FEMA)
S ECXERI=ECXPAT("ERI")
;get vietnam indicator fy14 144 cvw
S ECXVNS=ECXPAT("VIETNAM")
S ECXCLST=ECXPAT("CL STAT") ;144 Camp Lejeune Status
S ECXSVCI=ECXPAT("COMBSVCI") ;149 COMBAT SVC IND
S ECXSVCL=ECXPAT("COMBSVCL") ;149 COMBAT SVC LOC
S ECXSCST=ECXPAT("SC STAT") ;174 Service Connected Status
Q
;
PAT2(ECXDFN,ECXDATE) ;get date specific patient data
N K,X
;get primary care data
S X=$$PRIMARY^ECXUTL2(ECXDFN,$P(ECXDATE,"."))
S ECPTTM=$P(X,U),ECPTPR=$P(X,U,2),ECCLAS=$P(X,U,3),ECPTNPI=$P(X,U,4)
S ECASPR=$P(X,U,5),ECCLAS2=$P(X,U,6),ECASNPI=$P(X,U,7)
;get inpatient data
S X=$$INP^ECXUTL2(ECXDFN,ECXDATE),ECXA=$P(X,U),ECXTS=$P(X,U,3)
S ECXDOM=$P(X,U,10),ECXADMDT=$P(X,U,4),ECXASIH=$P(X,U,14) ;170
;- set national patient record flag if exist
D NPRF^ECXUTL5
Q
;
FILE2(ECXFILE,EC7,ECODE) ;file record
N DA,DIK,X S X=""
F S X=$O(ECODE(X)) Q:X="" S ^ECX(ECXFILE,EC7,X)=ECODE(X)
S DA=EC7,DIK="^ECX("_ECXFILE_"," D IX1^DIK K DIK,DA
I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
Q
;
CBOC(MDIV) ;Determine whether patient's facility was CBOC
N LOCARR,DIC,DR,DIQ,DA,INST,FTYP
S DIC=40.8,DA=MDIV,DR=".07",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1
S INST=$G(LOCARR(40.8,MDIV,.07,"I")) I INST="" Q ""
K LOCARR S DIC=4,DA=INST,DR="13",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1
S FTYP=$G(LOCARR(4,INST,13,"I")) I FTYP="" Q ""
K LOCARR S DIC=4.1,DA=FTYP,DR=".01",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1
Q $S($G(LOCARR(4.1,FTYP,.01,"I"))="CBOC":"Y",1:"")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXSCX2 3392 printed Apr 09, 2024@20:58:31 Page 2
ECXSCX2 ;ALB/ESD DSS Clinic Extract Utilities (continued) ;1/30/19 15:36
+1 ;;3.0;DSS EXTRACTS;**39,46,49,71,84,92,105,120,127,144,149,170,174,184**;Dec 22, 1997;Build 124
+2 ;
+3 ;
INTPAT ;initialize patient variables
+1 SET (ECXSSN,ECXPNM,ECPTPR,ECCLAS,ECPTNPI,ECASPR,ECCLAS2,ECASNPI,ECXZIP)=""
+2 SET (ECPTTM,ECXVET,ECXRACE,ECXENRL,ECXMPI,ECXSEX,ECXVNS)=""
+3 SET (ECXDOB,ECXELIG,ECXPST,ECXPLOC,ECXRST,ECXAST,ECXMST,ECXSTATE)=""
+4 SET (ECXCNTY,ECXCNTRY,ECXATYP,ECXPVST,ECXMTST,ECXEST,ECXECE,ECXHNC)=""
+5 ;149
SET (ECXESC,ECXECL,ECXCLST,ECXSVCI,ECXSVCL)=""
+6 ;184
SET (ECXSIGI,ECXSTA6,ECXNMPI,ECXCSTA,ECXCERN1,ECXCERN2)=""
+7 QUIT
+8 ;
PAT1(ECXDFN,ECXDATE,ECXERR) ;get patient demographic data
+1 NEW ECXPAT,K,OK,X
+2 SET ECXERR=0
+3 SET OK=$$PAT^ECXUTL3(ECXDFN,$PIECE(ECXDATE,"."),"1;2;3;4;5",.ECXPAT)
+4 IF 'OK
SET ECXERR=1
QUIT
+5 SET ECXSSN=ECXPAT("SSN")
SET ECXPNM=ECXPAT("NAME")
SET ECXMPI=ECXPAT("MPI")
+6 SET ECXSEX=ECXPAT("SEX")
SET ECXDOB=ECXPAT("DOB")
SET ECXELIG=ECXPAT("ELIG")
+7 SET ECXVET=ECXPAT("VET")
SET ECXSVC=ECXPAT("SC%")
SET ECXRACE=ECXPAT("RACE")
+8 SET ECXPST=ECXPAT("POW STAT")
SET ECXPLOC=ECXPAT("POW LOC")
+9 SET ECXRST=ECXPAT("IR STAT")
SET ECXAST=ECXPAT("AO STAT")
+10 SET ECXMST=ECXPAT("MST STAT")
SET ECXSTATE=ECXPAT("STATE")
+11 SET ECXCNTY=ECXPAT("COUNTY")
SET ECXZIP=ECXPAT("ZIP")
+12 SET ECXCNTRY=ECXPAT("COUNTRY")
+13 SET ECXENRL=ECXPAT("ENROLL LOC")
SET ECXMTST=ECXPAT("MEANS")
+14 ;184 Self Idenfied Gender
SET ECXSIGI=ECXPAT("SIGI")
+15 ; changes for 2001
+16 SET ECXPOS=ECXPAT("POS")
SET ECXPHI=ECXPAT("PHI")
+17 ;- Agent Orange location
+18 SET ECXAOL=ECXPAT("AOL")
+19 ;OEF/OIF data
+20 SET ECXOEF=ECXPAT("ECXOEF")
+21 SET ECXOEFDT=ECXPAT("ECXOEFDT")
+22 IF $$ENROLLM^ECXUTL2(ECXDFN)
+23 ; - Head and Neck Cancer Indicator
+24 SET ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
+25 ; - PROJ 112/SHAD Indicator
+26 SET ECXSHADI=$$SHAD^ECXUTL4(ECXDFN)
+27 ; - Race and Ethnicity
+28 SET ECXETH=ECXPAT("ETHNIC")
+29 SET ECXRC1=ECXPAT("RACE1")
+30 ; - Environmental Contaminants
+31 SET ECXEST=ECXPAT("EC STAT")
+32 ;get emergency response indicator (FEMA)
+33 SET ECXERI=ECXPAT("ERI")
+34 ;get vietnam indicator fy14 144 cvw
+35 SET ECXVNS=ECXPAT("VIETNAM")
+36 ;144 Camp Lejeune Status
SET ECXCLST=ECXPAT("CL STAT")
+37 ;149 COMBAT SVC IND
SET ECXSVCI=ECXPAT("COMBSVCI")
+38 ;149 COMBAT SVC LOC
SET ECXSVCL=ECXPAT("COMBSVCL")
+39 ;174 Service Connected Status
SET ECXSCST=ECXPAT("SC STAT")
+40 QUIT
+41 ;
PAT2(ECXDFN,ECXDATE) ;get date specific patient data
+1 NEW K,X
+2 ;get primary care data
+3 SET X=$$PRIMARY^ECXUTL2(ECXDFN,$PIECE(ECXDATE,"."))
+4 SET ECPTTM=$PIECE(X,U)
SET ECPTPR=$PIECE(X,U,2)
SET ECCLAS=$PIECE(X,U,3)
SET ECPTNPI=$PIECE(X,U,4)
+5 SET ECASPR=$PIECE(X,U,5)
SET ECCLAS2=$PIECE(X,U,6)
SET ECASNPI=$PIECE(X,U,7)
+6 ;get inpatient data
+7 SET X=$$INP^ECXUTL2(ECXDFN,ECXDATE)
SET ECXA=$PIECE(X,U)
SET ECXTS=$PIECE(X,U,3)
+8 ;170
SET ECXDOM=$PIECE(X,U,10)
SET ECXADMDT=$PIECE(X,U,4)
SET ECXASIH=$PIECE(X,U,14)
+9 ;- set national patient record flag if exist
+10 DO NPRF^ECXUTL5
+11 QUIT
+12 ;
FILE2(ECXFILE,EC7,ECODE) ;file record
+1 NEW DA,DIK,X
SET X=""
+2 FOR
SET X=$ORDER(ECODE(X))
if X=""
QUIT
SET ^ECX(ECXFILE,EC7,X)=ECODE(X)
+3 SET DA=EC7
SET DIK="^ECX("_ECXFILE_","
DO IX1^DIK
KILL DIK,DA
+4 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET QFLG=1
+5 QUIT
+6 ;
CBOC(MDIV) ;Determine whether patient's facility was CBOC
+1 NEW LOCARR,DIC,DR,DIQ,DA,INST,FTYP
+2 SET DIC=40.8
SET DA=MDIV
SET DR=".07"
SET DIQ(0)="I"
SET DIQ="LOCARR"
DO EN^DIQ1
+3 SET INST=$GET(LOCARR(40.8,MDIV,.07,"I"))
IF INST=""
QUIT ""
+4 KILL LOCARR
SET DIC=4
SET DA=INST
SET DR="13"
SET DIQ(0)="I"
SET DIQ="LOCARR"
DO EN^DIQ1
+5 SET FTYP=$GET(LOCARR(4,INST,13,"I"))
IF FTYP=""
QUIT ""
+6 KILL LOCARR
SET DIC=4.1
SET DA=FTYP
SET DR=".01"
SET DIQ(0)="I"
SET DIQ="LOCARR"
DO EN^DIQ1
+7 QUIT $SELECT($GET(LOCARR(4.1,FTYP,.01,"I"))="CBOC":"Y",1:"")
