source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECXSCX2.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1ECXSCX2 ;ALB/ESD DSS Clinic Extract Utilities (continued) ; 6/5/2007
2 ;;3.0;DSS EXTRACTS;**39,46,49,71,84,92,105**;Dec 22, 1997;Build 70
3 ;
4 ;
5INTPAT ;initialize patient variables
6 S (ECXSSN,ECXPNM,ECPTPR,ECCLAS,ECPTNPI,ECASPR,ECCLAS2,ECASNPI,ECXZIP)=""
7 S (ECPTTM,ECXVET,ECXRACE,ECXENRL,ECXMPI,ECXSEX)=""
8 S (ECXDOB,ECXELIG,ECXPST,ECXPLOC,ECXRST,ECXAST,ECXMST,ECXSTATE)=""
9 S (ECXCNTY,ECXATYP,ECXPVST,ECXMTST,ECXEST,ECXECE,ECXHNC)=""
10 Q
11 ;
12PAT1(ECXDFN,ECXDATE,ECXERR) ;get patient demographic data
13 N ECXPAT,K,OK,X
14 S ECXERR=0
15 S OK=$$PAT^ECXUTL3(ECXDFN,$P(ECXDATE,"."),"1;2;3;4;5",.ECXPAT)
16 I 'OK S ECXERR=1 Q
17 S ECXSSN=ECXPAT("SSN"),ECXPNM=ECXPAT("NAME"),ECXMPI=ECXPAT("MPI")
18 S ECXSEX=ECXPAT("SEX"),ECXDOB=ECXPAT("DOB"),ECXELIG=ECXPAT("ELIG")
19 S ECXVET=ECXPAT("VET"),ECXSVC=ECXPAT("SC%"),ECXRACE=ECXPAT("RACE")
20 S ECXPST=ECXPAT("POW STAT"),ECXPLOC=ECXPAT("POW LOC")
21 S ECXRST=ECXPAT("IR STAT"),ECXAST=ECXPAT("AO STAT")
22 S ECXMST=ECXPAT("MST STAT"),ECXSTATE=ECXPAT("STATE")
23 S ECXCNTY=ECXPAT("COUNTY"),ECXZIP=ECXPAT("ZIP")
24 S ECXENRL=ECXPAT("ENROLL LOC"),ECXMTST=ECXPAT("MEANS")
25 ; changes for 2001
26 S ECXPOS=ECXPAT("POS"),ECXPHI=ECXPAT("PHI")
27 ;- Agent Orange location
28 S ECXAOL=ECXPAT("AOL")
29 ;OEF/OIF data
30 S ECXOEF=ECXPAT("ECXOEF")
31 S ECXOEFDT=ECXPAT("ECXOEFDT")
32 I $$ENROLLM^ECXUTL2(ECXDFN)
33 ; - Head and Neck Cancer Indicator
34 S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
35 ; - Race and Ethnicity
36 S ECXETH=ECXPAT("ETHNIC")
37 S ECXRC1=ECXPAT("RACE1")
38 ; - Environmental Contaminants
39 S ECXEST=ECXPAT("EC STAT")
40 ;get emergency response indicator (FEMA)
41 S ECXERI=ECXPAT("ERI")
42 Q
43 ;
44PAT2(ECXDFN,ECXDATE) ;get date specific patient data
45 N K,X
46 ;get primary care data
47 S X=$$PRIMARY^ECXUTL2(ECXDFN,$P(ECXDATE,"."))
48 S ECPTTM=$P(X,U),ECPTPR=$P(X,U,2),ECCLAS=$P(X,U,3),ECPTNPI=$P(X,U,4)
49 S ECASPR=$P(X,U,5),ECCLAS2=$P(X,U,6),ECASNPI=$P(X,U,7)
50 ;get inpatient data
51 S X=$$INP^ECXUTL2(ECXDFN,ECXDATE),ECXA=$P(X,U),ECXTS=$P(X,U,3)
52 S ECXDOM=$P(X,U,10),ECXADMDT=$P(X,U,4)
53 ;- set national patient record flag if exist
54 D NPRF^ECXUTL5
55 Q
56 ;
57FILE2(ECXFILE,EC7,ECODE) ;file record
58 N DA,DIK,X S X=""
59 F S X=$O(ECODE(X)) Q:X="" S ^ECX(ECXFILE,EC7,X)=ECODE(X)
60 S DA=EC7,DIK="^ECX("_ECXFILE_"," D IX1^DIK K DIK,DA
61 I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
62 Q
63 ;
64CBOC(MDIV) ;Determine whether patient's facility was CBOC
65 N LOCARR,DIC,DR,DIQ,DA,INST,FTYP
66 S DIC=40.8,DA=MDIV,DR=".07",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1
67 S INST=$G(LOCARR(40.8,MDIV,.07,"I")) I INST="" Q ""
68 K LOCARR S DIC=4,DA=INST,DR="13",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1
69 S FTYP=$G(LOCARR(4,INST,13,"I")) I FTYP="" Q ""
70 K LOCARR S DIC=4.1,DA=FTYP,DR=".01",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1
71 Q $S($G(LOCARR(4.1,FTYP,.01,"I"))="CBOC":"Y",1:"")
Note: See TracBrowser for help on using the repository browser.