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

RGHLUT.m

Go to the documentation of this file.
  1. RGHLUT ;CAIRO/DKM-HL7 message processing utilities ;04-Sep-1998
  1. ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
  1. ;=================================================================
  1. ; Converts HL7 style date/time to FileMan format.
  1. DTHF(RGDT) ;
  1. Q:RGDT="" ""
  1. Q $$FMDATE^HLFNC(RGDT)
  1. ; Converts Fileman style date/time to HL7 format.
  1. DTFH(RGDT,RGTZ) ;
  1. Q:RGDT="" ""
  1. S RGTZ=$S('(RGDT#1):"",$G(RGTZ):$$TZ(RGDT,1),1:"")
  1. S:RGDT>1 RGDT=RGDT+17000000
  1. S:RGDT#1 RGDT=RGDT*10000
  1. S:RGDT#1 RGDT=RGDT*100\1
  1. Q RGDT_RGTZ
  1. ; Get time zone offset for this site
  1. TZ(RGDT,RGHL) ;
  1. N RGTZ,RGSN
  1. S RGTZ=$P($G(^RGSITE("COR",1,"TZ")),U,1+$$ISDST(.RGDT))
  1. S:'RGTZ RGTZ=+$G(^RGSITE("COR",1,"TZ"))
  1. S RGTZ=$P($G(^XMB(4.4,RGTZ,0)),U,3)
  1. Q:RGTZ=""!'$G(RGHL) RGTZ
  1. I RGTZ<0 S RGSN="-",RGTZ=-RGTZ
  1. E S RGSN="+"
  1. Q RGSN_$E(RGTZ\1+100,2,3)_$E(RGTZ#1*60\1+100,2,3)
  1. ; Determine if FM date is during DST
  1. ISDST(RGDAT) ;
  1. N RGD1,RGD2,RGDY,RGYR
  1. S:'$G(RGDAT) RGDAT=$$NOW^XLFDT
  1. S RGYR=RGDAT\10000*10000
  1. ; Find first Sunday in April of target year
  1. S RGD1=+$$FMTH^XLFDT(RGYR+401),RGDY=RGD1#7
  1. S RGD1=$$HTFM^XLFDT(RGD1+$S(RGDY>3:10-RGDY,1:3-RGDY))+.02
  1. ; Find last Sunday in October of target year
  1. S RGD2=+$$FMTH^XLFDT(RGYR+1031),RGDY=RGD2#7
  1. S RGD2=$$HTFM^XLFDT(RGD2-$S(RGDY=3:0,RGDY>3:RGDY-3,1:4+RGDY))+.02
  1. Q RGDAT'<RGD1&(RGDAT<RGD2)
  1. ; Get ICN (convert if old format)
  1. GETICN(RGDFN) ;
  1. S RGDFN=$$GETICN^MPIF001(RGDFN)
  1. Q $S(RGDFN?1.N1"^"1.N:$TR(RGDFN,U,"V"),1:RGDFN)
  1. ; Get DFN from ICN
  1. ICN2DFN(RGICN,RGCHK) ;
  1. N RGDFN
  1. S RGDFN=$$GETDFN^MPIF001(RGICN)
  1. I RGDFN>0,$D(RGCHK) D
  1. .S RGICN=$$GETICN(RGDFN)
  1. .S RGDFN=$S(RGICN<0:RGICN,+$P(RGICN,"V",2)'=+RGCHK:"-1^INVALID ICN CHECKSUM",1:RGDFN)
  1. Q RGDFN
  1. ; Lookup institution, returning IEN
  1. INST(RGINST) ;
  1. Q +$$FIND1^DIC(4,,"MX",RGINST)
  1. ; Convert HL7 suffix code to attribute
  1. SFX2ATR(RGSFX) ;
  1. Q:'$L(RGSFX) ""
  1. S:RGSFX'=+RGSFX RGSFX=+$O(^RGHL7(991.7,"B",RGSFX,0))
  1. Q $S(RGSFX:$P(^RGHL7(991.7,RGSFX,0),U,2),1:"")
  1. ; HL7 <==> COR flag conversion
  1. FLG(RGFLG,RGDLM,RGHL) ;
  1. N RGZ,RGC,RGR
  1. S RGHL=''$G(RGHL),RGR=""
  1. F RGZ=1:1:$S(RGHL:$L(RGFLG,RGDLM),1:$L(RGFLG)) D
  1. .S RGC=$S(RGHL:$P(RGFLG,RGDLM,RGZ),1:$E(RGFLG,RGZ))
  1. .Q:RGC=""
  1. .S RGC=$O(^RGHL7(991.2,$S(RGHL:"B",1:"AC"),RGC,0))
  1. .Q:'RGC
  1. .S RGC=$P(^RGHL7(991.2,RGC,0),U,RGHL+1)
  1. .S:RGC'="" RGR=RGR_$S(RGR="":"",RGHL:"",1:RGDLM)_RGC
  1. Q RGR
  1. ; Parse fields from RGREC into target array RGFLD using delimiter RGD.
  1. ; RGREC and RGFLD must be passed by reference.
  1. FLD(RGREC,RGFLD,RGD) ;
  1. N RGG,RGZ,RGI,RGJ,RGC
  1. K RGFLD
  1. S RGG="RGREC",RGC=0
  1. F D Q:RGG=""
  1. .S RGZ=$G(@RGG),RGJ=$L(RGZ,RGD)
  1. .F RGI=1:1:RGJ S RGFLD(RGC)=$G(RGFLD(RGC))_$P(RGZ,RGD,RGI),RGC=RGC+(RGI'=RGJ)
  1. .S RGG=$Q(@RGG)
  1. Q
  1. ; Parse MSH header
  1. MSH(RGMSH,RGARY) ;
  1. N RGZ
  1. Q:$E(RGMSH,1,3)'="MSH" 0
  1. S RGARY("FS")=$E(RGMSH,4)
  1. F RGZ=2:1:7,9:1:12 D
  1. .S RGARY($P("^ECH^SAN^SAF^RAN^RAF^DTM^^MTN^MID^PID^VER",U,RGZ))=$P(RGMSH,RGARY("FS"),RGZ)
  1. S RGZ=$E(RGARY("ECH")),RGARY("ETN")=$P(RGARY("MTN"),RGZ,2),RGARY("MTN")=$P(RGARY("MTN"),RGZ)
  1. Q 1
  1. ; Convert HL7 escape codes
  1. ESCAPE(RGTXT) ;
  1. N RGZ,RGRTN
  1. S RGRTN=""
  1. F Q:RGTXT'[RGD(4) D
  1. .S RGRTN=RGRTN_$P(RGTXT,RGD(4)),RGZ=$P(RGTXT,RGD(4),2),RGTXT=$P(RGTXT,RGD(4),3,999)
  1. .I $L(RGZ)=1 D
  1. ..S RGZ1=$F("FSRET",RGZ)-1
  1. ..S:RGZ1>0 RGRTN=RGRTN_RGD(RGZ1)
  1. .E I $E(RGZ)="X" D
  1. ..F RGZ1=2:2:$L(RGZ) S RGRTN=RGRTN_$C($$BASE^XLFUTL($E(RGZ,RGZ1,RGZ1+1),16,10))
  1. Q RGRTN_RGTXT