Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECXUTL4

ECXUTL4.m

Go to the documentation of this file. 
  1. ECXUTL4 ;ALB/ESD - Utilities for DSS Extracts ;4/24/19  09:44
  1.  ;;3.0;DSS EXTRACTS;**39,41,46,49,78,92,105,112,120,127,154,170,174,178,181**;Dec 22,1997;Build 71
  1.  ;
  1. OBSPAT(ECXIO,ECXTS,DSSID) ;
  1.  ; Get observation patient indicator from DSS TREATING SPECIALTY
  1.  ; TRANSLATION file (#727.831) or DSS Identifier
  1.  ;
  1.  ; Input:
  1.  ;   ECXIO  - Inpatient/Outpatient indicator
  1.  ;   ECXTS  - Treating specialty (from file #42.4)
  1.  ;   DSSID  - DSS Identifier
  1.  ;
  1.  ;Output:
  1.  ;   ECXOBS - Observation patient indicator (YES/NO)
  1.  ;
  1.  ;- Check input vars
  1.  S ECXIO=$G(ECXIO),ECXTS=+$G(ECXTS),DSSID=+$G(DSSID)
  1.  S ECXOBS=""
  1.  D
  1.  .;- Look up obs patient indicator if treating spec is in file #727.831
  1.  . I $G(^ECX(727.831,ECXTS,0)) S ECXOBS=$P($G(^ECX(727.831,ECXTS,0)),"^",4)
  1.  . I ECXOBS'="" S ECXOBS=$S(ECXOBS="Y":"YES",1:"NO") Q
  1.  .;
  1.  .;- If outpatient and TS not in file, AND Feeder Key (CLI) or DSS ID
  1.  .;- (MTL,IVP,ECQ,QSR,NOS,SUR) is 290-297, Observation Patient Ind=YES
  1.  . I ECXIO="O",ECXOBS="",DSSID D
  1.  .. I $E(DSSID,1,3)>289&($E(DSSID,1,3)<298) S ECXOBS="YES"
  1.  .. E  S ECXOBS="NO"
  1.  Q $S(ECXOBS'="":ECXOBS,1:"NO")
  1.  ;
  1. INOUTP(ECXTS) ;
  1.  ; Get inpatient/outpatient indicator from DSS TREATING SPECIALTY
  1.  ; TRANSLATION file (#727.831)
  1.  ;
  1.  ; Input:
  1.  ;   ECXTS   - Treating specialty
  1.  ;
  1.  ; Output:
  1.  ;             Inpatient/Outpatient indicator (I/O)
  1.  ;
  1.  S ECXTS=+$G(ECXTS)
  1.  S ECXIO=""
  1.  ;
  1.  ;- Look up inpat/outpat indicator if treating spec is in file
  1.  I $G(^ECX(727.831,ECXTS,0)) S ECXIO=$P($G(^ECX(727.831,ECXTS,0)),"^",5)
  1.  Q $S(ECXIO'="":ECXIO,1:"I")
  1.  ;
  1. ENCNUM(ECXIO,ECXSSN,ECXADT,ECXVDT,ECXTRT,ECXOBS,ECXEXT,ECXSTP,ECXSTP2) ;
  1.  ; Get encounter number
  1.  ;
  1.  ; Input:
  1.  ;   ECXIO   - Inpat/Outpat indicator = I or O
  1.  ;   ECXSSN  - Patient SSN
  1.  ;   ECXADT  - Admit Date
  1.  ;   ECXVDT  - Visit Date
  1.  ;   ECXTRT  - Treating Spec
  1.  ;   ECXOBS  - Observation Pat Indicator
  1.  ;   ECXEXT  - Extract
  1.  ;   ECXSTP  - Stop Code (or stop code related) variable
  1.  ;   ECXSTP2 - Stop Code (or stop code related) addtl variable
  1.  ;             (used for SUR and ECS)
  1.  ;
  1.  ;Output:
  1.  ;             Encounter Number
  1.  ;
  1.  N ENCNUM,ECXDATE,ECXSTCD
  1.  S (ENCNUM,ECXSTCD)=""
  1.  ;
  1.  ;- Check input vars
  1.  S ECXEXT=$G(ECXEXT),ECXIO=$G(ECXIO),ECXOBS=$G(ECXOBS),ECXTRT=+$G(ECXTRT)
  1.  S:ECXEXT'="ECS"&(ECXEXT'="ECQ") ECXSTP=+$G(ECXSTP) S ECXSTP2=+$G(ECXSTP2) ;154 Allow stop code/DSS ID for ECS&ECQ to be non-numeric
  1.  S ECXADT=+$G(ECXADT),ECXVDT=+$G(ECXVDT)
  1.  ;
  1.  ;- Don't use pseudo-SSN in encounter number
  1.  S ECXSSN=$E($G(ECXSSN),1,9)
  1.  ;
  1.  D
  1.  . ;- Inpatient
  1.  . I ECXIO="I",ECXADT,ECXSSN'="" D  Q
  1.  .. S ECXDATE=$$ADMITDT(ECXADT)
  1.  .. I ECXDATE'="" S ENCNUM=ECXSSN_ECXDATE_"I"
  1.  . ;
  1.  . ;- Outpatient branch
  1.  . I ECXIO="O" D
  1.  .. ;- Observation patient (outpatient)
  1.  .. I ECXOBS="YES",ECXSSN'="" D  Q
  1.  ... ;
  1.  ... S ECXDATE=$S(ECXADT:$$JULDT(ECXADT),1:$$JULDT(ECXVDT))
  1.  ... S ECXSTCD=$S(+$P($G(^ECX(727.831,ECXTRT,0)),"^",6):+$P($G(^ECX(727.831,ECXTRT,0)),"^",6),1:+$E(ECXSTP,1,3))
  1.  ... Q:ECXDATE=""!(ECXSTCD="")
  1.  ... S ENCNUM=ECXSSN_ECXDATE_ECXSTCD
  1.  .. ;
  1.  .. ;- Outpatient (no observation pat)
  1.  .. I ECXOBS="NO",ECXVDT,ECXSSN'="" D  Q
  1.  ... ;
  1.  ... ;- ADM, MOV, TRT have no outpat encounter number
  1.  ... I ECXEXT="ADM"!(ECXEXT="MOV")!(ECXEXT="TRT") Q
  1.  ... ;
  1.  ... ;- Use 1st 3 chars of DSS ID for NOS (feeder key for CLI)
  1.  ... I ECXEXT="CLI"!(ECXEXT="NOS") S ECXSTCD=+$E(ECXSTP,1,3) Q:'ECXSTCD
  1.  ... ;
  1.  ... ;- 154, For ECS remove cost center conversion. For ECS and ECQ set stop code to first 3 characters of ECXSTP
  1.  ... I ECXEXT="ECS"!(ECXEXT="ECQ") S ECXSTCD=$E(ECXSTP,1,3) ;154
  1.  ... ;
  1.  ... ;- These extracts have predetermined stop code values
  1.  ... I ECXEXT="DEN" S ECXSTCD=180
  1.  ... I ECXEXT="UDP"!(ECXEXT="PRE") S ECXSTCD="PHA" ;170
  1.  ... ;I ECXEXT="IVP" S ECXSTCD=$S(ECXSTP=0:"PHA","^AN100^AN200^AN300^AN400^AN500^AN600^AN700^AN900^OP900^"[("^"_$G(ECVACL)_"^"):$E(ECXSTP,1,3),1:"PHA") ;170 Set stop code for IVP
  1.  ... I ECXEXT="IVP" D  ;170 Set stop code for IVP
  1.  .... N DRUGCLAS,DRUGSTCD
  1.  .... S DRUGCLAS="^AN100^AN200^AN300^AN400^AN500^AN600^AN700^AN900^OP900^" ;List of Chemo Drugs
  1.  .... S DRUGSTCD="^308^316^329^330^407^" ; List of MCAO-defined Stop Code for patch 178, 181 - Remove 153 from the list
  1.  .... ;Only set the ECXSTP variable to the Ordering Stop Code for Chemo drugs ordered from this range
  1.  .... S ECXSTCD=$S(ECXSTP=0:"PHA",DRUGCLAS[("^"_ECVACL_"^"):$S(DRUGSTCD[("^"_ECXSTP_"^"):$E(ECXSTP,1,3),1:"PHA"),1:"PHA") ;170;178
  1.  ... I ECXEXT="LAB"!(ECXEXT="LAR")!(ECXEXT="LBB") S ECXSTCD=108
  1.  ... I ECXEXT="MTL" S ECXSTCD=538
  1.  ... I ECXEXT="NUR" S ECXSTCD=950
  1.  ... I ECXEXT="PRO" S ECXSTCD=423
  1.  ... I ECXEXT="NUT" S ECXSTCD="NUT"
  1.  ... I ECXEXT="BCM" S ECXSTCD="BCM"
  1.  ... ;
  1.  ... ;- If Imaging Type fld=2, use 109 otherwise use 105
  1.  ... I ECXEXT="RAD" S ECXSTCD=$S(ECXSTP=2:109,1:105)
  1.  ... ;
  1.  ... ;- Use STOP CODE fld if populated or if non-OR procedure use 435
  1.  ... ;- otherwise if null use 429
  1.  ... I ECXEXT="SUR" S ECXSTCD=$S(ECXSTP:ECXSTP,$P($G(ECNO),U)="Y":435,1:429) ;174 If no stop code, default to 435 for non-OR procedure else 429
  1.  ... ;
  1.  ... ;- Get Julian Date
  1.  ... S ECXDATE=$$JULDT(ECXVDT)
  1.  ... I ECXDATE'="" S ENCNUM=ECXSSN_ECXDATE_ECXSTCD
  1.  Q ENCNUM
  1.  ;
  1. ADMITDT(ECXINDT) ; Returns date in YYMMDD format
  1.  ;
  1.  ; Input:
  1.  ;   ECXINDT - Date (can also include time) in internal FM format
  1.  ;
  1.  ;Output:
  1.  ;             Date in YYMMDD form
  1.  ;
  1.  N ECXDT
  1.  S ECXDT=""
  1.  S ECXINDT=+$G(ECXINDT)
  1.  ;
  1.  ;- If no input or full FM date not passed in, quit
  1.  I 'ECXINDT!($L(ECXINDT)<7) G ADMTDTQ
  1.  ;
  1.  ;- Date in YYMMDD form
  1.  S ECXDT=$TR($$FMTE^XLFDT(ECXINDT,"4DF")," /","0")
  1. ADMTDTQ Q ECXDT
  1.  ;
  1.  ;
  1. JULDT(ECXINDT) ;  Returns Julian Date in MMDDD format
  1.  ;
  1.  ; Input:
  1.  ;   ECINDT  - Date (can also include time) in internal FM format
  1.  ;
  1.  ;Output:
  1.  ;             Julian date in MM_DDD form
  1.  ;
  1.  N ECXDDD,ECXDT,ECXJUL,ECXMM
  1.  S (ECXDDD,ECXMM)=""
  1.  ;
  1.  ;- If no input or full FM date not passed in, quit
  1.  S ECXINDT=+$G(ECXINDT)
  1.  I 'ECXINDT!($L(ECXINDT)<7) G JULDTQ
  1.  ;
  1.  ;- Extract date portion
  1.  S ECXDT=$E(ECXINDT,1,7)
  1.  ;
  1.  ;- Get month (MM)
  1.  S ECXMM=$E(ECXINDT,2,3)
  1.  ;
  1.  ;- Number of day within year (DDD)
  1.  S ECXDDD=$$RJ^XLFSTR($$FMDIFF^XLFDT(ECXDT,$E(ECXDT,1,3)_"0101",1)+1,3,"0")
  1. JULDTQ Q ECXMM_ECXDDD
  1.  ;
  1. CNHSTAT(ECXDFN) ;  Get CNH (Contract Nursing Home) status
  1.  ;
  1.  ; Input:
  1.  ;   ECXDFN  - Patient DFN
  1.  ;
  1.  ;Output:
  1.  ;             CNH status (YES/NO)
  1.  ;
  1.  N ECXCNH
  1.  S ECXDFN=+$G(ECXDFN)
  1.  S ECXCNH=$P($G(^DPT(ECXDFN,"NHC")),U)
  1.  Q $S(ECXCNH="Y":"YES",ECXCNH="N":"NO",1:"")
  1.  ;
  1. CANC(ECXNOR,ECXTMOR) ; Get Surgery Cancelled/Aborted Status
  1.  ;
  1.  ; Function called after determining CANCEL DATE in SURGERY record exists
  1.  ;
  1.  ; Input:
  1.  ;   ECXNOR   - Non-OR DSS ID
  1.  ;   ECXTMOR  - Time Pat in OR
  1.  ;
  1.  ;Output:
  1.  ;              Cancelled/aborted status (C/A)
  1.  ;
  1.  N ECXCANC
  1.  S ECXCANC=""
  1.  S ECXNOR=$G(ECXNOR)
  1.  ;
  1.  ;- If Non-OR DSS ID or Time Pat in OR, ECXCANC = "A" else = "C"
  1.  D
  1.  . I ECXNOR'=""&(ECXNOR'="UNKNOWN") S ECXCANC="A" Q
  1.  . I +$G(ECXTMOR) S ECXCANC="A" Q
  1.  . S ECXCANC="C"
  1.  Q ECXCANC
  1.  ;
  1. HNCI(ECXDFN) ; Get head & neck cancer indicator
  1.  ;
  1.  ; Input:
  1.  ;   ECXDFN  - Patient DFN
  1.  ;
  1.  ;Output:
  1.  ;             Head/Neck CA DX (Y/N)
  1.  ;
  1.  N ECXHNCI,DGNT
  1.  S ECXHNCI=""
  1.  S ECXDFN=+$G(ECXDFN) I ECXDFN D
  1.  .I $$GETCUR^DGNTAPI(ECXDFN,"DGNT") S ECXHNCI=$P(DGNT("HNC"),U)
  1.  Q ECXHNCI
  1.  ;
  1. TSMAP(ECXTS) ;Determines DSS Identifier for the following observation
  1.  ; treating specialty
  1.  ; Input:
  1.  ;   ECXTS - Observation Treating Specialty
  1.  ;
  1.  ; Output:
  1.  ;   DSS Identifier (Stop Code)
  1.  ;
  1.  N TS,SC,I
  1.  S TS="^18^23^24^41^65^94^108^",SC="^293^295^290^296^291^292^297^"
  1.  F I=1:1:$L(TS) Q:$P(TS,"^",I)=ECXTS
  1.  Q $P(SC,"^",I)_"000"
  1. OEFDATA ;
  1.  ;get patient OEF/OIF status and date of return
  1.  S (ECXOEF,ECXOEFDT)=""
  1.  I $G(VASV(11))>0 S ECXOEF=ECXOEF_"OIF"
  1.  I $G(VASV(12))>0 S ECXOEF=ECXOEF_"OEF"
  1.  I $G(VASV(13))>0 S ECXOEF=ECXOEF_"UNK"
  1.  I ECXOEF'="" D
  1.  . S ECXOEFDT=""
  1.  . I $G(VASV(11))>0 S ECXOEFDT=$P($G(VASV(11,$G(VASV(11)),3)),"^")
  1.  . I $G(VASV(12))>0,$P($G(VASV(12,$G(VASV(12)),3)),"^")>ECXOEFDT S ECXOEFDT=$P($G(VASV(12,$G(VASV(12)),3)),"^")
  1.  . I $G(VASV(13))>0,$P($G(VASV(13,$G(VASV(13)),3)),"^")>ECXOEFDT S ECXOEFDT=$P($G(VASV(13,$G(VASV(13)),3)),"^")
  1.  . I ECXOEFDT>0 S ECXOEFDT=17000000+ECXOEFDT
  1.  ;
  1.  S ECXPAT("ECXOEF")=ECXOEF
  1.  S ECXPAT("ECXOEFDT")=ECXOEFDT
  1.  Q
  1.  ;
  1. SHAD(ECXDFN) ; Get PROJ 112/SHAD indicator
  1.  ;
  1.  ; Input:
  1.  ;   ECXDFN  - Patient DFN
  1.  ;
  1.  ;Output:
  1.  ;             PROJ 112/SHAD DX (Y/N/U)
  1.  ;             Error -1, missing parameter
  1.  ;
  1.  N ECXSHAD
  1.  S ECXDFN=$G(ECXDFN)
  1.  S ECXSHAD=$$GETSHAD^DGUTL3(ECXDFN)
  1.  S ECXSHAD=$S(ECXSHAD=1:"Y",ECXSHAD=0:"N",ECXSHAD="":"U",1:-1)
  1.  Q ECXSHAD