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/ECXUTL4.m

    r613 r623  
    1 ECXUTL4 ;ALB/ESD - Utilities for DSS Extracts ; 11/26/07 10:58am
    2         ;;3.0;DSS EXTRACTS;**39,41,46,49,78,92,105**;Dec 22,1997;Build 70
    3         ;
    4 OBSPAT(ECXIO,ECXTS,DSSID)       ;
    5         ; Get observation patient indicator from DSS TREATING SPECIALTY
    6         ; TRANSLATION file (#727.831) or DSS Identifier
    7         ;
    8         ; Input:
    9         ;   ECXIO  - Inpatient/Outpatient indicator
    10         ;   ECXTS  - Treating specialty (from file #42.4)
    11         ;   DSSID  - DSS Identifier
    12         ;
    13         ;Output:
    14         ;   ECXOBS - Observation patient indicator (YES/NO)
    15         ;
    16         ;- Check input vars
    17         S ECXIO=$G(ECXIO),ECXTS=+$G(ECXTS),DSSID=+$G(DSSID)
    18         S ECXOBS=""
    19         D
    20         .;- Look up obs patient indicator if treating spec is in file #727.831
    21         . I $G(^ECX(727.831,ECXTS,0)) S ECXOBS=$P($G(^ECX(727.831,ECXTS,0)),"^",4)
    22         . I ECXOBS'="" S ECXOBS=$S(ECXOBS="Y":"YES",1:"NO") Q
    23         .;
    24         .;- If outpatient and TS not in file, AND Feeder Key (CLI) or DSS ID
    25         .;- (MTL,IVP,ECQ,QSR,NOS,SUR) is 290-296, Observation Patient Ind=YES
    26         . I ECXIO="O",ECXOBS="",DSSID D
    27         .. I $E(DSSID,1,3)>289&($E(DSSID,1,3)<297) S ECXOBS="YES"
    28         .. E  S ECXOBS="NO"
    29         Q $S(ECXOBS'="":ECXOBS,1:"NO")
    30         ;
    31 INOUTP(ECXTS)   ;
    32         ; Get inpatient/outpatient indicator from DSS TREATING SPECIALTY
    33         ; TRANSLATION file (#727.831)
    34         ;
    35         ; Input:
    36         ;   ECXTS   - Treating specialty
    37         ;
    38         ; Output:
    39         ;             Inpatient/Outpatient indicator (I/O)
    40         ;
    41         S ECXTS=+$G(ECXTS)
    42         S ECXIO=""
    43         ;
    44         ;- Look up inpat/outpat indicator if treating spec is in file
    45         I $G(^ECX(727.831,ECXTS,0)) S ECXIO=$P($G(^ECX(727.831,ECXTS,0)),"^",5)
    46         Q $S(ECXIO'="":ECXIO,1:"I")
    47         ;
    48 ENCNUM(ECXIO,ECXSSN,ECXADT,ECXVDT,ECXTRT,ECXOBS,ECXEXT,ECXSTP,ECXSTP2)  ;
    49         ; Get encounter number
    50         ;
    51         ; Input:
    52         ;   ECXIO   - Inpat/Outpat indicator = I or O
    53         ;   ECXSSN  - Patient SSN
    54         ;   ECXADT  - Admit Date
    55         ;   ECXVDT  - Visit Date
    56         ;   ECXTRT  - Treating Spec
    57         ;   ECXOBS  - Observation Pat Indicator
    58         ;   ECXEXT  - Extract
    59         ;   ECXSTP  - Stop Code (or stop code related) variable
    60         ;   ECXSTP2 - Stop Code (or stop code related) addtl variable
    61         ;             (used for SUR and ECS)
    62         ;
    63         ;Output:
    64         ;             Encounter Number
    65         ;
    66         N ENCNUM,ECXDATE,ECXSTCD
    67         S (ENCNUM,ECXSTCD)=""
    68         ;
    69         ;- Check input vars
    70         S ECXEXT=$G(ECXEXT),ECXIO=$G(ECXIO),ECXOBS=$G(ECXOBS),ECXTRT=+$G(ECXTRT)
    71         S ECXSTP=+$G(ECXSTP),ECXSTP2=+$G(ECXSTP2)
    72         S ECXADT=+$G(ECXADT),ECXVDT=+$G(ECXVDT)
    73         ;
    74         ;- Don't use pseudo-SSN in encounter number
    75         S ECXSSN=$E($G(ECXSSN),1,9)
    76         ;
    77         D
    78         . ;- Inpatient
    79         . I ECXIO="I",ECXADT,ECXSSN'="" D  Q
    80         .. S ECXDATE=$$ADMITDT(ECXADT)
    81         .. I ECXDATE'="" S ENCNUM=ECXSSN_ECXDATE_"I"
    82         . ;
    83         . ;- Outpatient branch
    84         . I ECXIO="O" D
    85         .. ;- Observation patient (outpatient)
    86         .. I ECXOBS="YES",ECXSSN'="" D  Q
    87         ... ;
    88         ... S ECXDATE=$S(ECXADT:$$JULDT(ECXADT),1:$$JULDT(ECXVDT))
    89         ... S ECXSTCD=$S(+$P($G(^ECX(727.831,ECXTRT,0)),"^",6):+$P($G(^ECX(727.831,ECXTRT,0)),"^",6),1:+$E(ECXSTP,1,3))
    90         ... Q:ECXDATE=""!(ECXSTCD="")
    91         ... S ENCNUM=ECXSSN_ECXDATE_ECXSTCD
    92         .. ;
    93         .. ;- Outpatient (no observation pat)
    94         .. I ECXOBS="NO",ECXVDT,ECXSSN'="" D  Q
    95         ... ;
    96         ... ;- ADM, MOV, TRT have no outpat encounter number
    97         ... I ECXEXT="ADM"!(ECXEXT="MOV")!(ECXEXT="TRT") Q
    98         ... ;
    99         ... ;- Use 1st 3 chars of DSS ID for NOS and ECQ (feeder key for CLI)
    100         ... ;- Use observation stop code for IVP
    101         ... I ECXEXT="CLI"!(ECXEXT="NOS")!(ECXEXT="ECQ")!(ECXEXT="IVP") S ECXSTCD=+$E(ECXSTP,1,3) Q:'ECXSTCD
    102         ... ;
    103         ... ;- Use cost center to obtain stop code for ECS
    104         ... I ECXEXT="ECS" D  Q:'ECXSTCD
    105         .... S ECXSTCD=$$ECSCOST(ECXSTP2)
    106         ....;
    107         ....;- If no cost center, use 1st 3 chars of DSS ID
    108         .... I ECXSTCD="" S ECXSTCD=+$E(ECXSTP,1,3)
    109         ... ;
    110         ... ;- These extracts have predetermined stop code values
    111         ... I ECXEXT="DEN" S ECXSTCD=180
    112         ... I ECXEXT="PRE"!(ECXEXT="UDP") S ECXSTCD=160
    113         ... I ECXEXT="LAB"!(ECXEXT="LAR")!(ECXEXT="LBB") S ECXSTCD=108
    114         ... I ECXEXT="MTL" S ECXSTCD=538
    115         ... I ECXEXT="NUR" S ECXSTCD=950
    116         ... I ECXEXT="PRO" S ECXSTCD=423
    117         ... I ECXEXT="NUT" S ECXSTCD="NUT"
    118         ... ;
    119         ... ;- If Imaging Type fld=2, use 109 otherwise use 105
    120         ... I ECXEXT="RAD" S ECXSTCD=$S(ECXSTP=2:109,1:105)
    121         ... ;
    122         ... ;- Use DSS STOP CODE fld if populated or if SURG SPEC fld=59 use 430
    123         ... ;- otherwise if null use 429
    124         ... I ECXEXT="SUR" S ECXSTCD=$S(ECXSTP:ECXSTP,ECXSTP2=59:430,1:429)
    125         ... ;
    126         ... ;- Get Julian Date
    127         ... S ECXDATE=$$JULDT(ECXVDT)
    128         ... I ECXDATE'="" S ENCNUM=ECXSSN_ECXDATE_ECXSTCD
    129         Q ENCNUM
    130         ;
    131 ADMITDT(ECXINDT)        ; Returns date in YYMMDD format
    132         ;
    133         ; Input:
    134         ;   ECXINDT - Date (can also include time) in internal FM format
    135         ;
    136         ;Output:
    137         ;             Date in YYMMDD form
    138         ;
    139         N ECXDT
    140         S ECXDT=""
    141         S ECXINDT=+$G(ECXINDT)
    142         ;
    143         ;- If no input or full FM date not passed in, quit
    144         I 'ECXINDT!($L(ECXINDT)<7) G ADMTDTQ
    145         ;
    146         ;- Date in YYMMDD form
    147         S ECXDT=$TR($$FMTE^XLFDT(ECXINDT,"4DF")," /","0")
    148 ADMTDTQ Q ECXDT
    149         ;
    150         ;
    151 JULDT(ECXINDT)  ;  Returns Julian Date in MMDDD format
    152         ;
    153         ; Input:
    154         ;   ECINDT  - Date (can also include time) in internal FM format
    155         ;
    156         ;Output:
    157         ;             Julian date in MM_DDD form
    158         ;
    159         N ECXDDD,ECXDT,ECXJUL,ECXMM
    160         S (ECXDDD,ECXMM)=""
    161         ;
    162         ;- If no input or full FM date not passed in, quit
    163         S ECXINDT=+$G(ECXINDT)
    164         I 'ECXINDT!($L(ECXINDT)<7) G JULDTQ
    165         ;
    166         ;- Extract date portion
    167         S ECXDT=$E(ECXINDT,1,7)
    168         ;
    169         ;- Get month (MM)
    170         S ECXMM=$E(ECXINDT,2,3)
    171         ;
    172         ;- Number of day within year (DDD)
    173         S ECXDDD=$$RJ^XLFSTR($$FMDIFF^XLFDT(ECXDT,$E(ECXDT,1,3)_"0101",1)+1,3,"0")
    174 JULDTQ  Q ECXMM_ECXDDD
    175         ;
    176 CNHSTAT(ECXDFN) ;  Get CNH (Contract Nursing Home) status
    177         ;
    178         ; Input:
    179         ;   ECXDFN  - Patient DFN
    180         ;
    181         ;Output:
    182         ;             CNH status (YES/NO)
    183         ;
    184         N ECXCNH
    185         S ECXDFN=+$G(ECXDFN)
    186         S ECXCNH=$P($G(^DPT(ECXDFN,"NHC")),U)
    187         Q $S(ECXCNH="Y":"YES",ECXCNH="N":"NO",1:"")
    188         ;
    189 CANC(ECXNOR,ECXTMOR)    ; Get Surgery Cancelled/Aborted Status
    190         ;
    191         ; Function called after determining CANCEL DATE in SURGERY record exists
    192         ;
    193         ; Input:
    194         ;   ECXNOR   - Non-OR DSS ID
    195         ;   ECXTMOR  - Time Pat in OR
    196         ;
    197         ;Output:
    198         ;              Cancelled/aborted status (C/A)
    199         ;
    200         N ECXCANC
    201         S ECXCANC=""
    202         S ECXNOR=$G(ECXNOR)
    203         ;
    204         ;- If Non-OR DSS ID or Time Pat in OR, ECXCANC = "A" else = "C"
    205         D
    206         . I ECXNOR'=""&(ECXNOR'="UNKNOWN") S ECXCANC="A" Q
    207         . I +$G(ECXTMOR) S ECXCANC="A" Q
    208         . S ECXCANC="C"
    209         Q ECXCANC
    210         ;
    211 ECSCOST(ECXCOST)        ;Get ECS extract stop code based on cost center
    212         ;
    213         ;
    214         ; Input:
    215         ;   ECXCOST  - ECS extract cost center
    216         ;
    217         ;Output:
    218         ;              ECS extract stop code
    219         ;
    220         N ECXFND,ECXSTOP,I
    221         S ECXFND=0
    222         S ECXSTOP=""
    223         S ECXCOST=+$G(ECXCOST)
    224         D
    225         . I 'ECXCOST Q
    226         . F I=1:1 Q:ECXFND!($P($T(COST+I),";;",2)="END")  D
    227         .. I ECXCOST=$P($T(COST+I),";;",2) S ECXSTOP=$P($T(COST+I),";;",3),ECXFND=1
    228         Q ECXSTOP
    229         ;
    230 COST    ;- ECS Cost Center and stop code
    231         ;;833100;;652
    232         ;;833200;;653
    233         ;;833300;;681
    234         ;;834100;;651
    235         ;;834200;;650
    236         ;;834300;;681
    237         ;;834400;;654
    238         ;;834500;;681
    239         ;;834600;;681
    240         ;;834700;;681
    241         ;;834800;;681
    242         ;;834900;;681
    243         ;;836100;;654
    244         ;;836200;;654
    245         ;;END
    246         ;
    247 HNCI(ECXDFN)    ; Get head & neck cancer indicator
    248         ;
    249         ; Input:
    250         ;   ECXDFN  - Patient DFN
    251         ;
    252         ;Output:
    253         ;             Head/Neck CA DX (Y/N)
    254         ;
    255         N ECXHNCI,DGNT
    256         S ECXHNCI=""
    257         S ECXDFN=+$G(ECXDFN) I ECXDFN D
    258         .I $$GETCUR^DGNTAPI(ECXDFN,"DGNT") S ECXHNCI=$P(DGNT("HNC"),U)
    259         Q ECXHNCI
    260         ;
    261 TSMAP(ECXTS)    ;Determines DSS Identifier for the following observation
    262         ; treating specialty
    263         ; Input:
    264         ;   ECXTS - Observation Treating Specialty
    265         ;
    266         ; Output:
    267         ;   DSS Identifier (Stop Code)
    268         ;
    269         N TS,SC,I
    270         S TS="^18^23^24^36^41^65^94^",SC="^293^295^290^294^296^291^292^"
    271         F I=1:1:$L(TS) Q:$P(TS,"^",I)=ECXTS
    272         Q $P(SC,"^",I)_"000"
    273 OEFDATA ;
    274         ;get patient OEF/OIF status and date of return
    275         S (ECXOEF,ECXOEFDT)=""
    276         I $G(VASV(11))>0 S ECXOEF=ECXOEF_"OIF"
    277         I $G(VASV(12))>0 S ECXOEF=ECXOEF_"OEF"
    278         I $G(VASV(13))>0 S ECXOEF=ECXOEF_"UNK"
    279         I ECXOEF'="" D
    280         . S ECXOEFDT=""
    281         . I $G(VASV(11))>0 S ECXOEFDT=$P($G(VASV(11,$G(VASV(11)),3)),"^")
    282         . I $G(VASV(12))>0,$P($G(VASV(12,$G(VASV(12)),3)),"^")>ECXOEFDT S ECXOEFDT=$P($G(VASV(12,$G(VASV(12)),3)),"^")
    283         . I $G(VASV(13))>0,$P($G(VASV(13,$G(VASV(13)),3)),"^")>ECXOEFDT S ECXOEFDT=$P($G(VASV(13,$G(VASV(13)),3)),"^")
    284         . I ECXOEFDT>0 S ECXOEFDT=17000000+ECXOEFDT
    285         ;
    286         S ECXPAT("ECXOEF")=ECXOEF
    287         S ECXPAT("ECXOEFDT")=ECXOEFDT
    288         Q
     1ECXUTL4 ;ALB/ESD - Utilities for DSS Extracts ; 11/2/06 9:08am
     2 ;;3.0;DSS EXTRACTS;**39,41,46,49,78,92**;Dec 22,1997;Build 30
     3 ;
     4OBSPAT(ECXIO,ECXTS,DSSID) ;
     5 ; Get observation patient indicator from DSS TREATING SPECIALTY
     6 ; TRANSLATION file (#727.831) or DSS Identifier
     7 ;
     8 ; Input:
     9 ;   ECXIO  - Inpatient/Outpatient indicator
     10 ;   ECXTS  - Treating specialty (from file #42.4)
     11 ;   DSSID  - DSS Identifier
     12 ;
     13 ;Output:
     14 ;   ECXOBS - Observation patient indicator (YES/NO)
     15 ;
     16 ;- Check input vars
     17 S ECXIO=$G(ECXIO),ECXTS=+$G(ECXTS),DSSID=+$G(DSSID)
     18 S ECXOBS=""
     19 D
     20 .;- Look up obs patient indicator if treating spec is in file #727.831
     21 . I $G(^ECX(727.831,ECXTS,0)) S ECXOBS=$P($G(^ECX(727.831,ECXTS,0)),"^",4)
     22 . I ECXOBS'="" S ECXOBS=$S(ECXOBS="Y":"YES",1:"NO") Q
     23 .;
     24 .;- If outpatient and TS not in file, AND Feeder Key (CLI) or DSS ID
     25 .;- (MTL,IVP,ECQ,QSR,NOS,SUR) is 290-296, Observation Patient Ind=YES
     26 . I ECXIO="O",ECXOBS="",DSSID D
     27 .. I $E(DSSID,1,3)>289&($E(DSSID,1,3)<297) S ECXOBS="YES"
     28 .. E  S ECXOBS="NO"
     29 Q $S(ECXOBS'="":ECXOBS,1:"NO")
     30 ;
     31INOUTP(ECXTS) ;
     32 ; Get inpatient/outpatient indicator from DSS TREATING SPECIALTY
     33 ; TRANSLATION file (#727.831)
     34 ;
     35 ; Input:
     36 ;   ECXTS   - Treating specialty
     37 ;
     38 ; Output:
     39 ;             Inpatient/Outpatient indicator (I/O)
     40 ;
     41 S ECXTS=+$G(ECXTS)
     42 S ECXIO=""
     43 ;
     44 ;- Look up inpat/outpat indicator if treating spec is in file
     45 I $G(^ECX(727.831,ECXTS,0)) S ECXIO=$P($G(^ECX(727.831,ECXTS,0)),"^",5)
     46 Q $S(ECXIO'="":ECXIO,1:"I")
     47 ;
     48ENCNUM(ECXIO,ECXSSN,ECXADT,ECXVDT,ECXTRT,ECXOBS,ECXEXT,ECXSTP,ECXSTP2) ;
     49 ; Get encounter number
     50 ;
     51 ; Input:
     52 ;   ECXIO   - Inpat/Outpat indicator = I or O
     53 ;   ECXSSN  - Patient SSN
     54 ;   ECXADT  - Admit Date
     55 ;   ECXVDT  - Visit Date
     56 ;   ECXTRT  - Treating Spec
     57 ;   ECXOBS  - Observation Pat Indicator
     58 ;   ECXEXT  - Extract
     59 ;   ECXSTP  - Stop Code (or stop code related) variable
     60 ;   ECXSTP2 - Stop Code (or stop code related) addtl variable
     61 ;             (used for SUR and ECS)
     62 ;
     63 ;Output:
     64 ;             Encounter Number
     65 ;
     66 N ENCNUM,ECXDATE,ECXSTCD
     67 S (ENCNUM,ECXSTCD)=""
     68 ;
     69 ;- Check input vars
     70 S ECXEXT=$G(ECXEXT),ECXIO=$G(ECXIO),ECXOBS=$G(ECXOBS),ECXTRT=+$G(ECXTRT)
     71 S ECXSTP=+$G(ECXSTP),ECXSTP2=+$G(ECXSTP2)
     72 S ECXADT=+$G(ECXADT),ECXVDT=+$G(ECXVDT)
     73 ;
     74 ;- Don't use pseudo-SSN in encounter number
     75 S ECXSSN=$E($G(ECXSSN),1,9)
     76 ;
     77 D
     78 . ;- Inpatient
     79 . I ECXIO="I",ECXADT,ECXSSN'="" D  Q
     80 .. S ECXDATE=$$ADMITDT(ECXADT)
     81 .. I ECXDATE'="" S ENCNUM=ECXSSN_ECXDATE_"I"
     82 . ;
     83 . ;- Outpatient branch
     84 . I ECXIO="O" D
     85 .. ;- Observation patient (outpatient)
     86 .. I ECXOBS="YES",ECXSSN'="" D  Q
     87 ... ;
     88 ... S ECXDATE=$S(ECXADT:$$JULDT(ECXADT),1:$$JULDT(ECXVDT))
     89 ... S ECXSTCD=$S(+$P($G(^ECX(727.831,ECXTRT,0)),"^",6):+$P($G(^ECX(727.831,ECXTRT,0)),"^",6),1:+$E(ECXSTP,1,3))
     90 ... Q:ECXDATE=""!(ECXSTCD="")
     91 ... S ENCNUM=ECXSSN_ECXDATE_ECXSTCD
     92 .. ;
     93 .. ;- Outpatient (no observation pat)
     94 .. I ECXOBS="NO",ECXVDT,ECXSSN'="" D  Q
     95 ... ;
     96 ... ;- ADM, MOV, TRT have no outpat encounter number
     97 ... I ECXEXT="ADM"!(ECXEXT="MOV")!(ECXEXT="TRT") Q
     98 ... ;
     99 ... ;- Use 1st 3 chars of DSS ID for NOS and ECQ (feeder key for CLI)
     100 ... ;- Use observation stop code for IVP
     101 ... I ECXEXT="CLI"!(ECXEXT="NOS")!(ECXEXT="ECQ")!(ECXEXT="IVP") S ECXSTCD=+$E(ECXSTP,1,3) Q:'ECXSTCD
     102 ... ;
     103 ... ;- Use cost center to obtain stop code for ECS
     104 ... I ECXEXT="ECS" D  Q:'ECXSTCD
     105 .... S ECXSTCD=$$ECSCOST(ECXSTP2)
     106 ....;
     107 ....;- If no cost center, use 1st 3 chars of DSS ID
     108 .... I ECXSTCD="" S ECXSTCD=+$E(ECXSTP,1,3)
     109 ... ;
     110 ... ;- These extracts have predetermined stop code values
     111 ... I ECXEXT="DEN" S ECXSTCD=180
     112 ... I ECXEXT="PRE"!(ECXEXT="UDP") S ECXSTCD=160
     113 ... I ECXEXT="LAB"!(ECXEXT="LAR")!(ECXEXT="LBB") S ECXSTCD=108
     114 ... I ECXEXT="MTL" S ECXSTCD=538
     115 ... I ECXEXT="NUR" S ECXSTCD=950
     116 ... I ECXEXT="PRO" S ECXSTCD=423
     117 ... I ECXEXT="NUT" S ECXSTCD="NUT"
     118 ... ;
     119 ... ;- If Imaging Type fld=2, use 109 otherwise use 105
     120 ... I ECXEXT="RAD" S ECXSTCD=$S(ECXSTP=2:109,1:105)
     121 ... ;
     122 ... ;- Use DSS STOP CODE fld if populated or if SURG SPEC fld=59 use 430
     123 ... ;- otherwise if null use 429
     124 ... I ECXEXT="SUR" S ECXSTCD=$S(ECXSTP:ECXSTP,ECXSTP2=59:430,1:429)
     125 ... ;
     126 ... ;- Get Julian Date
     127 ... S ECXDATE=$$JULDT(ECXVDT)
     128 ... I ECXDATE'="" S ENCNUM=ECXSSN_ECXDATE_ECXSTCD
     129 Q ENCNUM
     130 ;
     131ADMITDT(ECXINDT) ; Returns date in YYMMDD format
     132 ;
     133 ; Input:
     134 ;   ECXINDT - Date (can also include time) in internal FM format
     135 ;
     136 ;Output:
     137 ;             Date in YYMMDD form
     138 ;
     139 N ECXDT
     140 S ECXDT=""
     141 S ECXINDT=+$G(ECXINDT)
     142 ;
     143 ;- If no input or full FM date not passed in, quit
     144 I 'ECXINDT!($L(ECXINDT)<7) G ADMTDTQ
     145 ;
     146 ;- Date in YYMMDD form
     147 S ECXDT=$TR($$FMTE^XLFDT(ECXINDT,"4DF")," /","0")
     148ADMTDTQ Q ECXDT
     149 ;
     150 ;
     151JULDT(ECXINDT) ;  Returns Julian Date in MMDDD format
     152 ;
     153 ; Input:
     154 ;   ECINDT  - Date (can also include time) in internal FM format
     155 ;
     156 ;Output:
     157 ;             Julian date in MM_DDD form
     158 ;
     159 N ECXDDD,ECXDT,ECXJUL,ECXMM
     160 S (ECXDDD,ECXMM)=""
     161 ;
     162 ;- If no input or full FM date not passed in, quit
     163 S ECXINDT=+$G(ECXINDT)
     164 I 'ECXINDT!($L(ECXINDT)<7) G JULDTQ
     165 ;
     166 ;- Extract date portion
     167 S ECXDT=$E(ECXINDT,1,7)
     168 ;
     169 ;- Get month (MM)
     170 S ECXMM=$E(ECXINDT,2,3)
     171 ;
     172 ;- Number of day within year (DDD)
     173 S ECXDDD=$$RJ^XLFSTR($$FMDIFF^XLFDT(ECXDT,$E(ECXDT,1,3)_"0101",1)+1,3,"0")
     174JULDTQ Q ECXMM_ECXDDD
     175 ;
     176CNHSTAT(ECXDFN) ;  Get CNH (Contract Nursing Home) status
     177 ;
     178 ; Input:
     179 ;   ECXDFN  - Patient DFN
     180 ;
     181 ;Output:
     182 ;             CNH status (YES/NO)
     183 ;
     184 N ECXCNH
     185 S ECXDFN=+$G(ECXDFN)
     186 S ECXCNH=$P($G(^DPT(ECXDFN,"NHC")),U)
     187 Q $S(ECXCNH="Y":"YES",ECXCNH="N":"NO",1:"")
     188 ;
     189CANC(ECXNOR,ECXTMOR) ; Get Surgery Cancelled/Aborted Status
     190 ;
     191 ; Function called after determining CANCEL DATE in SURGERY record exists
     192 ;
     193 ; Input:
     194 ;   ECXNOR   - Non-OR DSS ID
     195 ;   ECXTMOR  - Time Pat in OR
     196 ;
     197 ;Output:
     198 ;              Cancelled/aborted status (C/A)
     199 ;
     200 N ECXCANC
     201 S ECXCANC=""
     202 S ECXNOR=$G(ECXNOR)
     203 ;
     204 ;- If Non-OR DSS ID or Time Pat in OR, ECXCANC = "A" else = "C"
     205 D
     206 . I ECXNOR'=""&(ECXNOR'="UNKNOWN") S ECXCANC="A" Q
     207 . I +$G(ECXTMOR) S ECXCANC="A" Q
     208 . S ECXCANC="C"
     209 Q ECXCANC
     210 ;
     211ECSCOST(ECXCOST) ;Get ECS extract stop code based on cost center
     212 ;
     213 ;
     214 ; Input:
     215 ;   ECXCOST  - ECS extract cost center
     216 ;
     217 ;Output:
     218 ;              ECS extract stop code
     219 ;
     220 N ECXFND,ECXSTOP,I
     221 S ECXFND=0
     222 S ECXSTOP=""
     223 S ECXCOST=+$G(ECXCOST)
     224 D
     225 . I 'ECXCOST Q
     226 . F I=1:1 Q:ECXFND!($P($T(COST+I),";;",2)="END")  D
     227 .. I ECXCOST=$P($T(COST+I),";;",2) S ECXSTOP=$P($T(COST+I),";;",3),ECXFND=1
     228 Q ECXSTOP
     229 ;
     230COST ;- ECS Cost Center and stop code
     231 ;;833100;;652
     232 ;;833200;;653
     233 ;;833300;;681
     234 ;;834100;;651
     235 ;;834200;;650
     236 ;;834300;;681
     237 ;;834400;;654
     238 ;;834500;;681
     239 ;;834600;;681
     240 ;;834700;;681
     241 ;;834800;;681
     242 ;;834900;;681
     243 ;;836100;;654
     244 ;;836200;;654
     245 ;;END
     246 ;
     247HNCI(ECXDFN) ; Get head & neck cancer indicator
     248 ;
     249 ; Input:
     250 ;   ECXDFN  - Patient DFN
     251 ;
     252 ;Output:
     253 ;             Head/Neck CA DX (Y/N)
     254 ;
     255 N ECXHNCI,DGNT
     256 S ECXHNCI=""
     257 S ECXDFN=+$G(ECXDFN) I ECXDFN D
     258 .I $$GETCUR^DGNTAPI(ECXDFN,"DGNT") S ECXHNCI=$P(DGNT("HNC"),U)
     259 Q ECXHNCI
     260 ;
     261TSMAP(ECXTS) ;Determines DSS Identifier for the following observation
     262 ; treating specialty
     263 ; Input:
     264 ;   ECXTS - Observation Treating Specialty
     265 ;
     266 ; Output:
     267 ;   DSS Identifier (Stop Code)
     268 ;
     269 N TS,SC,I
     270 S TS="^18^23^24^36^41^65^94^",SC="^293^295^290^294^296^291^292^"
     271 F I=1:1:$L(TS) Q:$P(TS,"^",I)=ECXTS
     272 Q $P(SC,"^",I)_"000"
Note: See TracChangeset for help on using the changeset viewer.