source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXUTL.m@ 789

ECXUTL ;ALB/JAP - Utilities for DSS Extracts ; 12/12/05 8:43am
 ;;3.0;DSS EXTRACTS;**1,5,8,84,90**;Dec 22, 1997
 ;
ECXYM(ECXFMDT) ;extrinsic function
 ;converts any FM internal format date or date/time to a 6-character string
 ;
 ;   input
 ;   ECXFMDT = date or date/time; FM internal format (required)
 ;   output
 ;   ECXYM = YYYYMM string
 ;
 N MONTH,YEAR,CENTURY,ECXYM
 ;
 ;error checks
 I +ECXFMDT'=ECXFMDT S ECXYM="000000" Q ECXYM
 I $L($P(ECXFMDT,"."))'=7 S ECXYM="000000" Q ECXYM
 I +$E(ECXFMDT,4,5)<1!(+$E(ECXFMDT,4,5)>12) S ECXYM="000000" Q ECXYM
 ;
 S MONTH=$E(ECXFMDT,4,5),YEAR=$E(ECXFMDT,2,3),CENTURY=$E(ECXFMDT,1)+17
 S ECXYM=CENTURY_YEAR_MONTH
 Q ECXYM
 ;
ECXYMX(ECXYM) ;extrinsic function
 ;converts a 6-character numeric string of format YYYYMM
 ;to a FM external format date
 ;
 ;   input
 ;   ECXYM = YYYYMM string (required)
 ;   output
 ;   ECXYMX = FM external format date;
 ;            SEP 1997
 ;   error code
 ;   if input problem, then "000000" returned
 ;
 N Y,%DT,CENTURY,FMCENT,ECXYMX
 ;
 ;error checks
 I ECXYM="" S ECXYMX="000000" Q ECXYMX
 I +ECXYM'=ECXYM S ECXYMX="000000" Q ECXYMX
 I $L(ECXYM)'=6 S ECXYMX="000000" Q ECXYMX
 I +$E(ECXYM,1,4)<1800 S ECXYMX="000000" Q ECXYMX
 I +$E(ECXYM,5,6)<1!(+$E(ECXYM,5,6)>12) S ECXYMX="000000" Q ECXYMX
 ;
 S CENTURY=$E(ECXYM,1,2)
 S FMCENT=CENTURY-17
 S Y=FMCENT_$E(ECXYM,3,6) D DD^%DT S ECXYMX=Y
 ;
 ;error checks
 I $L(ECXYMX)'=8 S ECXYMX="000000"
 I "JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC"'[$E(ECXYMX,1,3) S ECXYMX="000000"
 Q ECXYMX
 ;
ECXDATE(ECXFMDT,ECXYM) ;extrinsic function
 ;converts any FM internal format date or date/time to a 8-character string
 ;
 ;   input
 ;   ECXFMDT = date or date/time; FM internal format (required)
 ;   ECXYM = YYYYMM; year/month 6-character string (required)
 ;   output
 ;   ECXDATE = YYYYMMDD string
 ;   error code
 ;   "000000" returned, if problem with input
 ;
 N MONTH,YEAR,CENTURY,DAY,ECXDATE
 ;
 ;error checks
 I +ECXYM'=ECXYM S ECXDATE="000000" Q ECXDATE
 I $L(ECXYM)'=6 S ECXDATE="000000" Q ECXDATE
 I +$E(ECXYM,1,4)<1800 S ECXDATE="000000" Q ECXDATE
 I +$E(ECXYM,5,6)<1!($E(ECXYM,5,6)>12) S ECXDATE="000000" Q ECXDATE
 ;special case where ecxfmdt is null; default to year/month of ecxym
 I ECXFMDT="" S ECXDATE=ECXYM_"01" Q ECXDATE
 ;error checks
 I +ECXFMDT'=ECXFMDT S ECXDATE=ECXYM_"01" Q ECXDATE
 I $L(ECXFMDT)<7 S ECXDATE=ECXYM_"01" Q ECXDATE
 I +$E(ECXFMDT,4,5)>12 S ECXDATE=ECXYM_"01" Q ECXDATE
 I +$E(ECXFMDT,6,7)>31 S ECXFMDT=$E(ECXFMDT,1,5)_"01"
 ;default to 1st day of month
 S DAY=$E(ECXFMDT,6,7) S:DAY="00" DAY="01"
 ;default to month of ecxym
 S MONTH=$E(ECXFMDT,4,5) S:MONTH="00" MONTH=$E(ECXYM,5,6)
 S YEAR=$E(ECXFMDT,2,3)
 S CENTURY=$E(ECXFMDT,1)+17
 S ECXDATE=CENTURY_YEAR_MONTH_DAY
 Q ECXDATE
 ;
ECXDATEX(ECXDATE) ;extrinsic function
 ;converts an 8-character numeric string of format YYYYMMDD
 ;to a FM external format date
 ;
 ;   input
 ;   ECXDATE = YYYYMMDD string (required)
 ;   output
 ;   ECXDATEX = FM external format date;
 ;              SEP 12, 1997
 ;   error code
 ;   if input problem, then "000000" returned
 ;
 N Y,%DT,CENTURY,FMCENT,ECXDATEX
 ;
 ;error checks
 I +ECXDATE'=ECXDATE S ECXDATEX="000000" Q ECXDATEX
 I $L(ECXDATE)'=8 S ECXDATEX="000000" Q ECXDATEX
 I +$E(ECXDATE,7,8)>31 S ECXDATEX="000000" Q ECXDATEX
 ;
 S CENTURY=$E(ECXDATE,1,2)
 S FMCENT=CENTURY-17
 S Y=FMCENT_$E(ECXDATE,3,8) D DD^%DT S ECXDATEX=Y
 ;
 ;error checks
 I $L(ECXDATEX)'=12 S ECXDATEX="000000"
 I "JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC"'[$E(ECXDATEX,1,3) S ECXDATEX="000000"
 Q ECXDATEX
 ;
ECXDOB(ECXFMDT) ;extrinsic function
 ;converts a FM internal format date or date/time to a 6-character string
 ;if ecxfmdt is null, the function returns 19420101
 ;   input
 ;   ECXFMDT = date or date/time (required); 
 ;             must be valid FM internal format 
 ;   output
 ;   ECXDOB = YYYYMMDD string (required);
 ;            defaults to 19420101
 ;
 N MONTH,YEAR,CENTURY,DAY,ECXDOB
 ;only consider date portion
 S ECXFMDT=$P(ECXFMDT,".",1)
 ;special case where ecxfmdt is null
 I ECXFMDT="" S ECXDOB="19420101" Q ECXDOB
 ;error checks - return default
 I +ECXFMDT'=ECXFMDT S ECXDOB="19420101" Q ECXDOB
 I $L(ECXFMDT)<7 S ECXDOB="19420101" Q ECXDOB
 I +ECXFMDT>DT S ECXDOB="19420101" Q ECXDOB
 ;default to 1st day of month
 S DAY=$E(ECXFMDT,6,7) S:DAY="00"!(+DAY>31) DAY="01"
 ;default to 1st month of year
 S MONTH=$E(ECXFMDT,4,5) S:MONTH="00"!(+MONTH>12) MONTH="01",DAY="01"
 S YEAR=$E(ECXFMDT,2,3)
 S CENTURY=$E(ECXFMDT,1)+17
 S ECXDOB=CENTURY_YEAR_MONTH_DAY
 Q ECXDOB
 ;
ECXTIME(ECXFMDT) ;extrinsic function
 ;converts Fileman internal date/time to 6-character time string
 ;format HHMMSS
 ;
 ;   input
 ;   ECXFMDT = date or date/time (required); 
 ;             must be valid FM internal format
 ;   output
 ;   ECXTIME = 6-character numeric string;
 ;             format HHMMSS; string length always 6
 ;
 N J,JJ,TIME,HH,MM,SS,ECXTIME
 ;if any non-numerics, set default
 I +ECXFMDT=0 S ECXTIME="000300" Q ECXTIME
 ;use only time portion of fileman internal format
 S TIME=$P(ECXFMDT,".",2),TIME=$E(TIME,1,6)
 ;if time unknown, set default
 I TIME="" S ECXTIME="000300" Q ECXTIME
 ;be sure time is 6 characters
 S TIME=$$LJ^XLFSTR(TIME,6,0)
 ;error checks -- set default
 S HH=$E(TIME,1,2),MM=$E(TIME,3,4),SS=$E(TIME,5,6)
 I +HH>23 S ECXTIME="000300" Q ECXTIME
 I +MM>59 S MM="59"
 I +SS>59 S SS="59"
 S ECXTIME=HH_MM_SS
 Q ECXTIME
 ;
ECXTIMEX(ECXTIME,ECXMIL) ;extrinsic function
 ;converts a 6-character time string to external, user readable format
 ;used as output transform for time fields in many dss extract files
 ;   input
 ;   ECXTIME = 6-character numeric string (required); 
 ;   ECXMIL = if "1", then return military time (optional)          
 ;   output
 ;   ECXTIMEX = character string;
 ;              if ECXMIL=1, format HH:MM:SS
 ;              otherwise, hours:mins AM/PM
 ;   error code
 ;   if input problem, then "000000" returned
 ;              
 N TIME,HH,MM,SS,ECXTIMEX,J,JJ
 ;error checks
 I $L(ECXTIME)'=6 S ECXTIMEX="000000" Q ECXTIMEX
 F J=1:1:6 S JJ=$E(ECXTIME,J) I $A(JJ)<48!($A(JJ)>57) S ECXTIMEX="000000" Q
 I $D(ECXTIMEX) Q ECXTIMEX
 S HH=$E(ECXTIME,1,2),MM=$E(ECXTIME,3,4),SS=$E(ECXTIME,5,6)
 I +HH>23!(+MM>59)!(+SS>59) S ECXTIMEX="000000" Q ECXTIMEX
 ;if ecxmil=1, return military time
 I $G(ECXMIL) S ECXTIMEX=HH_":"_MM_":"_SS Q ECXTIMEX
 ;otherwise, use am/pm format
 S X="0."_ECXTIME
 S X=$E($P(X,".",2)_"0000",1,4),%=X>1159 S:X>1259 X=X-1200
 S X=X\100_":"_$E(X#100+100,2,3)_" "_$E("AP",%+1)_"M"
 S ECXTIMEX=X
 Q ECXTIMEX
 ;
AOIRPOW(ECXDFN,ECXAIP) ;get data on ao, ir, pow status
 ;
 ;   input
 ;   ECXDFN = ien in file #2 (required)
 ;   ECXAIP = array for returned data (required)
 ;            (passed by reference)
 ;
 ;   output
 ;   ECXAIP("AO") = agent orange status
 ;   ECXAIP("IR") = ion. radiation status
 ;   ECXAIP("POW") = pow status
 ;   ECXAIP("POWL") = pow location/period
 ;
 N J
 S ECXAIP("AO")="",ECXAIP("IR")="",ECXAIP("POW")="",ECXAIP("POWL")=""
 S ECXAIP("AO")=$P($G(^DPT(ECXDFN,.321)),U,2),ECXAIP("IR")=$P($G(^(.321)),U,3)
 S ECXAIP("POW")=$P($G(^DPT(ECXDFN,.52)),U,5),ECXAIP("POWL")=$P($G(^(.52)),U,6)
 F J="AO","IR","POW" I ECXAIP(J)="" S ECXAIP(J)="U"
 I ECXAIP("POWL"),ECXAIP("POW")'="Y" S ECXAIP("POWL")=""
 Q
 ;
PRVCLASS(PERS,DATE) ;determine the person class and return va code
 ;   input
 ;   PERS  = pointer to file #200 (required)
 ;   DATE  = date on which person class must be active (required)
 ;           (internal Fileman format)
 ;   output
 ;   VACODE = VA code field from file #8932.1
 ;            (exactly 7 characters in length)
 N ECX,VACODE
 S VACODE=""
 S ECHEAD=$G(ECHEAD)
 S ECX=$$GET^XUA4A72(PERS,DATE)
 ;if no person class use alternate date to resolve person class
 I +ECX'>0 D
 .N DATE
 .S DATE=$S(ECHEAD="LAB":$P(EC1,U,14),ECHEAD="LAR":$P(EC1,U,4),ECHEAD="PRE":$P(ECDATA,U,13),ECHEAD="RAD":$P($G(^RAO(75.1,+$G(ECXIEN),0)),U,16),1:"")
 .S ECX=$$GET^XUA4A72(PERS,DATE)
 .Q
 S VACODE=$P(ECX,U,7) I $L(VACODE)'=7 S VACODE=""
 Q VACODE