source: FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUTL4.m@ 636

ECXUTL4 ;ALB/ESD - Utilities for DSS Extracts ; 11/2/06 9:08am
 ;;3.0;DSS EXTRACTS;**39,41,46,49,78,92**;Dec 22,1997;Build 30
 ;
OBSPAT(ECXIO,ECXTS,DSSID) ;
 ; Get observation patient indicator from DSS TREATING SPECIALTY
 ; TRANSLATION file (#727.831) or DSS Identifier
 ;
 ; Input:
 ;   ECXIO  - Inpatient/Outpatient indicator
 ;   ECXTS  - Treating specialty (from file #42.4)
 ;   DSSID  - DSS Identifier
 ;
 ;Output:
 ;   ECXOBS - Observation patient indicator (YES/NO)
 ;
 ;- Check input vars
 S ECXIO=$G(ECXIO),ECXTS=+$G(ECXTS),DSSID=+$G(DSSID)
 S ECXOBS=""
 D
 .;- Look up obs patient indicator if treating spec is in file #727.831
 . I $G(^ECX(727.831,ECXTS,0)) S ECXOBS=$P($G(^ECX(727.831,ECXTS,0)),"^",4)
 . I ECXOBS'="" S ECXOBS=$S(ECXOBS="Y":"YES",1:"NO") Q
 .;
 .;- If outpatient and TS not in file, AND Feeder Key (CLI) or DSS ID
 .;- (MTL,IVP,ECQ,QSR,NOS,SUR) is 290-296, Observation Patient Ind=YES
 . I ECXIO="O",ECXOBS="",DSSID D
 .. I $E(DSSID,1,3)>289&($E(DSSID,1,3)<297) S ECXOBS="YES"
 .. E  S ECXOBS="NO"
 Q $S(ECXOBS'="":ECXOBS,1:"NO")
 ;
INOUTP(ECXTS) ;
 ; Get inpatient/outpatient indicator from DSS TREATING SPECIALTY
 ; TRANSLATION file (#727.831)
 ;
 ; Input:
 ;   ECXTS   - Treating specialty
 ;
 ; Output:
 ;             Inpatient/Outpatient indicator (I/O)
 ;
 S ECXTS=+$G(ECXTS)
 S ECXIO=""
 ;
 ;- Look up inpat/outpat indicator if treating spec is in file
 I $G(^ECX(727.831,ECXTS,0)) S ECXIO=$P($G(^ECX(727.831,ECXTS,0)),"^",5)
 Q $S(ECXIO'="":ECXIO,1:"I")
 ;
ENCNUM(ECXIO,ECXSSN,ECXADT,ECXVDT,ECXTRT,ECXOBS,ECXEXT,ECXSTP,ECXSTP2) ;
 ; Get encounter number
 ;
 ; Input:
 ;   ECXIO   - Inpat/Outpat indicator = I or O
 ;   ECXSSN  - Patient SSN
 ;   ECXADT  - Admit Date
 ;   ECXVDT  - Visit Date
 ;   ECXTRT  - Treating Spec
 ;   ECXOBS  - Observation Pat Indicator
 ;   ECXEXT  - Extract
 ;   ECXSTP  - Stop Code (or stop code related) variable
 ;   ECXSTP2 - Stop Code (or stop code related) addtl variable
 ;             (used for SUR and ECS)
 ;
 ;Output:
 ;             Encounter Number
 ;
 N ENCNUM,ECXDATE,ECXSTCD
 S (ENCNUM,ECXSTCD)=""
 ;
 ;- Check input vars
 S ECXEXT=$G(ECXEXT),ECXIO=$G(ECXIO),ECXOBS=$G(ECXOBS),ECXTRT=+$G(ECXTRT)
 S ECXSTP=+$G(ECXSTP),ECXSTP2=+$G(ECXSTP2)
 S ECXADT=+$G(ECXADT),ECXVDT=+$G(ECXVDT)
 ;
 ;- Don't use pseudo-SSN in encounter number
 S ECXSSN=$E($G(ECXSSN),1,9)
 ;
 D
 . ;- Inpatient
 . I ECXIO="I",ECXADT,ECXSSN'="" D  Q
 .. S ECXDATE=$$ADMITDT(ECXADT)
 .. I ECXDATE'="" S ENCNUM=ECXSSN_ECXDATE_"I"
 . ;
 . ;- Outpatient branch
 . I ECXIO="O" D
 .. ;- Observation patient (outpatient)
 .. I ECXOBS="YES",ECXSSN'="" D  Q
 ... ;
 ... S ECXDATE=$S(ECXADT:$$JULDT(ECXADT),1:$$JULDT(ECXVDT))
 ... S ECXSTCD=$S(+$P($G(^ECX(727.831,ECXTRT,0)),"^",6):+$P($G(^ECX(727.831,ECXTRT,0)),"^",6),1:+$E(ECXSTP,1,3))
 ... Q:ECXDATE=""!(ECXSTCD="")
 ... S ENCNUM=ECXSSN_ECXDATE_ECXSTCD
 .. ;
 .. ;- Outpatient (no observation pat)
 .. I ECXOBS="NO",ECXVDT,ECXSSN'="" D  Q
 ... ;
 ... ;- ADM, MOV, TRT have no outpat encounter number
 ... I ECXEXT="ADM"!(ECXEXT="MOV")!(ECXEXT="TRT") Q
 ... ;
 ... ;- Use 1st 3 chars of DSS ID for NOS and ECQ (feeder key for CLI)
 ... ;- Use observation stop code for IVP
 ... I ECXEXT="CLI"!(ECXEXT="NOS")!(ECXEXT="ECQ")!(ECXEXT="IVP") S ECXSTCD=+$E(ECXSTP,1,3) Q:'ECXSTCD
 ... ;
 ... ;- Use cost center to obtain stop code for ECS
 ... I ECXEXT="ECS" D  Q:'ECXSTCD
 .... S ECXSTCD=$$ECSCOST(ECXSTP2)
 ....;
 ....;- If no cost center, use 1st 3 chars of DSS ID
 .... I ECXSTCD="" S ECXSTCD=+$E(ECXSTP,1,3)
 ... ;
 ... ;- These extracts have predetermined stop code values
 ... I ECXEXT="DEN" S ECXSTCD=180
 ... I ECXEXT="PRE"!(ECXEXT="UDP") S ECXSTCD=160
 ... I ECXEXT="LAB"!(ECXEXT="LAR")!(ECXEXT="LBB") S ECXSTCD=108
 ... I ECXEXT="MTL" S ECXSTCD=538
 ... I ECXEXT="NUR" S ECXSTCD=950
 ... I ECXEXT="PRO" S ECXSTCD=423
 ... I ECXEXT="NUT" S ECXSTCD="NUT"
 ... ;
 ... ;- If Imaging Type fld=2, use 109 otherwise use 105
 ... I ECXEXT="RAD" S ECXSTCD=$S(ECXSTP=2:109,1:105)
 ... ;
 ... ;- Use DSS STOP CODE fld if populated or if SURG SPEC fld=59 use 430
 ... ;- otherwise if null use 429
 ... I ECXEXT="SUR" S ECXSTCD=$S(ECXSTP:ECXSTP,ECXSTP2=59:430,1:429)
 ... ;
 ... ;- Get Julian Date
 ... S ECXDATE=$$JULDT(ECXVDT)
 ... I ECXDATE'="" S ENCNUM=ECXSSN_ECXDATE_ECXSTCD
 Q ENCNUM
 ;
ADMITDT(ECXINDT) ; Returns date in YYMMDD format
 ;
 ; Input:
 ;   ECXINDT - Date (can also include time) in internal FM format
 ;
 ;Output:
 ;             Date in YYMMDD form
 ;
 N ECXDT
 S ECXDT=""
 S ECXINDT=+$G(ECXINDT)
 ;
 ;- If no input or full FM date not passed in, quit
 I 'ECXINDT!($L(ECXINDT)<7) G ADMTDTQ
 ;
 ;- Date in YYMMDD form
 S ECXDT=$TR($$FMTE^XLFDT(ECXINDT,"4DF")," /","0")
ADMTDTQ Q ECXDT
 ;
 ;
JULDT(ECXINDT) ;  Returns Julian Date in MMDDD format
 ;
 ; Input:
 ;   ECINDT  - Date (can also include time) in internal FM format
 ;
 ;Output:
 ;             Julian date in MM_DDD form
 ;
 N ECXDDD,ECXDT,ECXJUL,ECXMM
 S (ECXDDD,ECXMM)=""
 ;
 ;- If no input or full FM date not passed in, quit
 S ECXINDT=+$G(ECXINDT)
 I 'ECXINDT!($L(ECXINDT)<7) G JULDTQ
 ;
 ;- Extract date portion
 S ECXDT=$E(ECXINDT,1,7)
 ;
 ;- Get month (MM)
 S ECXMM=$E(ECXINDT,2,3)
 ;
 ;- Number of day within year (DDD)
 S ECXDDD=$$RJ^XLFSTR($$FMDIFF^XLFDT(ECXDT,$E(ECXDT,1,3)_"0101",1)+1,3,"0")
JULDTQ Q ECXMM_ECXDDD
 ;
CNHSTAT(ECXDFN) ;  Get CNH (Contract Nursing Home) status
 ;
 ; Input:
 ;   ECXDFN  - Patient DFN
 ;
 ;Output:
 ;             CNH status (YES/NO)
 ;
 N ECXCNH
 S ECXDFN=+$G(ECXDFN)
 S ECXCNH=$P($G(^DPT(ECXDFN,"NHC")),U)
 Q $S(ECXCNH="Y":"YES",ECXCNH="N":"NO",1:"")
 ;
CANC(ECXNOR,ECXTMOR) ; Get Surgery Cancelled/Aborted Status
 ;
 ; Function called after determining CANCEL DATE in SURGERY record exists
 ;
 ; Input:
 ;   ECXNOR   - Non-OR DSS ID
 ;   ECXTMOR  - Time Pat in OR
 ;
 ;Output:
 ;              Cancelled/aborted status (C/A)
 ;
 N ECXCANC
 S ECXCANC=""
 S ECXNOR=$G(ECXNOR)
 ;
 ;- If Non-OR DSS ID or Time Pat in OR, ECXCANC = "A" else = "C"
 D
 . I ECXNOR'=""&(ECXNOR'="UNKNOWN") S ECXCANC="A" Q
 . I +$G(ECXTMOR) S ECXCANC="A" Q
 . S ECXCANC="C"
 Q ECXCANC
 ;
ECSCOST(ECXCOST) ;Get ECS extract stop code based on cost center
 ;
 ;
 ; Input:
 ;   ECXCOST  - ECS extract cost center
 ;
 ;Output:
 ;              ECS extract stop code
 ;
 N ECXFND,ECXSTOP,I
 S ECXFND=0
 S ECXSTOP=""
 S ECXCOST=+$G(ECXCOST)
 D
 . I 'ECXCOST Q
 . F I=1:1 Q:ECXFND!($P($T(COST+I),";;",2)="END")  D
 .. I ECXCOST=$P($T(COST+I),";;",2) S ECXSTOP=$P($T(COST+I),";;",3),ECXFND=1
 Q ECXSTOP
 ;
COST ;- ECS Cost Center and stop code
 ;;833100;;652
 ;;833200;;653
 ;;833300;;681
 ;;834100;;651
 ;;834200;;650
 ;;834300;;681
 ;;834400;;654
 ;;834500;;681
 ;;834600;;681
 ;;834700;;681
 ;;834800;;681
 ;;834900;;681
 ;;836100;;654
 ;;836200;;654
 ;;END
 ;
HNCI(ECXDFN) ; Get head & neck cancer indicator
 ;
 ; Input:
 ;   ECXDFN  - Patient DFN
 ;
 ;Output:
 ;             Head/Neck CA DX (Y/N)
 ;
 N ECXHNCI,DGNT
 S ECXHNCI=""
 S ECXDFN=+$G(ECXDFN) I ECXDFN D
 .I $$GETCUR^DGNTAPI(ECXDFN,"DGNT") S ECXHNCI=$P(DGNT("HNC"),U)
 Q ECXHNCI
 ;
TSMAP(ECXTS) ;Determines DSS Identifier for the following observation
 ; treating specialty
 ; Input:
 ;   ECXTS - Observation Treating Specialty
 ;
 ; Output:
 ;   DSS Identifier (Stop Code)
 ;
 N TS,SC,I
 S TS="^18^23^24^36^41^65^94^",SC="^293^295^290^294^296^291^292^"
 F I=1:1:$L(TS) Q:$P(TS,"^",I)=ECXTS
 Q $P(SC,"^",I)_"000"