Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXSCX2.m

    r613 r623  
    1 ECXSCX2 ;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         ;
    5 INTPAT  ;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         ;
    12 PAT1(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         ;
    44 PAT2(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         ;
    57 FILE2(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         ;
    64 CBOC(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:"")
     1ECXSCX2 ;ALB/ESD  DSS Clinic Extract Utilities (continued) ; 11/2/06 8:59am
     2 ;;3.0;DSS EXTRACTS;**39,46,49,71,84,92**;Dec 22, 1997;Build 30
     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 I $$ENROLLM^ECXUTL2(ECXDFN)
     30 ; - Head and Neck Cancer Indicator
     31 S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
     32 ; - Race and Ethnicity
     33 S ECXETH=ECXPAT("ETHNIC")
     34 S ECXRC1=ECXPAT("RACE1")
     35 ; - Environmental Contaminants
     36 S ECXEST=ECXPAT("EC STAT")
     37 ;get emergency response indicator (FEMA)
     38 S ECXERI=ECXPAT("ERI")
     39 Q
     40 ;
     41PAT2(ECXDFN,ECXDATE)    ;get date specific patient data
     42 N K,X
     43 ;get primary care data
     44 S X=$$PRIMARY^ECXUTL2(ECXDFN,$P(ECXDATE,"."))
     45 S ECPTTM=$P(X,U),ECPTPR=$P(X,U,2),ECCLAS=$P(X,U,3),ECPTNPI=$P(X,U,4)
     46 S ECASPR=$P(X,U,5),ECCLAS2=$P(X,U,6),ECASNPI=$P(X,U,7)
     47 ;get inpatient data
     48 S X=$$INP^ECXUTL2(ECXDFN,ECXDATE),ECXA=$P(X,U),ECXTS=$P(X,U,3)
     49 S ECXDOM=$P(X,U,10),ECXADMDT=$P(X,U,4)
     50 ;- set national patient record flag if exist
     51 D NPRF^ECXUTL5
     52 Q
     53 ;
     54FILE2(ECXFILE,EC7,ECODE) ;file record
     55 N DA,DIK,X S X=""
     56 F  S X=$O(ECODE(X)) Q:X=""  S ^ECX(ECXFILE,EC7,X)=ECODE(X)
     57 S DA=EC7,DIK="^ECX("_ECXFILE_"," D IX1^DIK K DIK,DA
     58 I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
     59 Q
     60 ;
     61CBOC(MDIV) ;Determine whether patient's facility was CBOC
     62 N LOCARR,DIC,DR,DIQ,DA,INST,FTYP
     63 S DIC=40.8,DA=MDIV,DR=".07",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1
     64 S INST=$G(LOCARR(40.8,MDIV,.07,"I")) I INST="" Q ""
     65 K LOCARR S DIC=4,DA=INST,DR="13",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1
     66 S FTYP=$G(LOCARR(4,INST,13,"I")) I FTYP="" Q ""
     67 K LOCARR S DIC=4.1,DA=FTYP,DR=".01",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1
     68 Q $S($G(LOCARR(4.1,FTYP,.01,"I"))="CBOC":"Y",1:"")
Note: See TracChangeset for help on using the changeset viewer.