| [613] | 1 | RGHLUT ;CAIRO/DKM-HL7 message processing utilities ;04-Sep-1998
|
|---|
| 2 | ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
|
|---|
| 3 | ;=================================================================
|
|---|
| 4 | ; Converts HL7 style date/time to FileMan format.
|
|---|
| 5 | DTHF(RGDT) ;
|
|---|
| 6 | Q:RGDT="" ""
|
|---|
| 7 | Q $$FMDATE^HLFNC(RGDT)
|
|---|
| 8 | ; Converts Fileman style date/time to HL7 format.
|
|---|
| 9 | DTFH(RGDT,RGTZ) ;
|
|---|
| 10 | Q:RGDT="" ""
|
|---|
| 11 | S RGTZ=$S('(RGDT#1):"",$G(RGTZ):$$TZ(RGDT,1),1:"")
|
|---|
| 12 | S:RGDT>1 RGDT=RGDT+17000000
|
|---|
| 13 | S:RGDT#1 RGDT=RGDT*10000
|
|---|
| 14 | S:RGDT#1 RGDT=RGDT*100\1
|
|---|
| 15 | Q RGDT_RGTZ
|
|---|
| 16 | ; Get time zone offset for this site
|
|---|
| 17 | TZ(RGDT,RGHL) ;
|
|---|
| 18 | N RGTZ,RGSN
|
|---|
| 19 | S RGTZ=$P($G(^RGSITE("COR",1,"TZ")),U,1+$$ISDST(.RGDT))
|
|---|
| 20 | S:'RGTZ RGTZ=+$G(^RGSITE("COR",1,"TZ"))
|
|---|
| 21 | S RGTZ=$P($G(^XMB(4.4,RGTZ,0)),U,3)
|
|---|
| 22 | Q:RGTZ=""!'$G(RGHL) RGTZ
|
|---|
| 23 | I RGTZ<0 S RGSN="-",RGTZ=-RGTZ
|
|---|
| 24 | E S RGSN="+"
|
|---|
| 25 | Q RGSN_$E(RGTZ\1+100,2,3)_$E(RGTZ#1*60\1+100,2,3)
|
|---|
| 26 | ; Determine if FM date is during DST
|
|---|
| 27 | ISDST(RGDAT) ;
|
|---|
| 28 | N RGD1,RGD2,RGDY,RGYR
|
|---|
| 29 | S:'$G(RGDAT) RGDAT=$$NOW^XLFDT
|
|---|
| 30 | S RGYR=RGDAT\10000*10000
|
|---|
| 31 | ; Find first Sunday in April of target year
|
|---|
| 32 | S RGD1=+$$FMTH^XLFDT(RGYR+401),RGDY=RGD1#7
|
|---|
| 33 | S RGD1=$$HTFM^XLFDT(RGD1+$S(RGDY>3:10-RGDY,1:3-RGDY))+.02
|
|---|
| 34 | ; Find last Sunday in October of target year
|
|---|
| 35 | S RGD2=+$$FMTH^XLFDT(RGYR+1031),RGDY=RGD2#7
|
|---|
| 36 | S RGD2=$$HTFM^XLFDT(RGD2-$S(RGDY=3:0,RGDY>3:RGDY-3,1:4+RGDY))+.02
|
|---|
| 37 | Q RGDAT'<RGD1&(RGDAT<RGD2)
|
|---|
| 38 | ; Get ICN (convert if old format)
|
|---|
| 39 | GETICN(RGDFN) ;
|
|---|
| 40 | S RGDFN=$$GETICN^MPIF001(RGDFN)
|
|---|
| 41 | Q $S(RGDFN?1.N1"^"1.N:$TR(RGDFN,U,"V"),1:RGDFN)
|
|---|
| 42 | ; Get DFN from ICN
|
|---|
| 43 | ICN2DFN(RGICN,RGCHK) ;
|
|---|
| 44 | N RGDFN
|
|---|
| 45 | S RGDFN=$$GETDFN^MPIF001(RGICN)
|
|---|
| 46 | I RGDFN>0,$D(RGCHK) D
|
|---|
| 47 | .S RGICN=$$GETICN(RGDFN)
|
|---|
| 48 | .S RGDFN=$S(RGICN<0:RGICN,+$P(RGICN,"V",2)'=+RGCHK:"-1^INVALID ICN CHECKSUM",1:RGDFN)
|
|---|
| 49 | Q RGDFN
|
|---|
| 50 | ; Lookup institution, returning IEN
|
|---|
| 51 | INST(RGINST) ;
|
|---|
| 52 | Q +$$FIND1^DIC(4,,"MX",RGINST)
|
|---|
| 53 | ; Convert HL7 suffix code to attribute
|
|---|
| 54 | SFX2ATR(RGSFX) ;
|
|---|
| 55 | Q:'$L(RGSFX) ""
|
|---|
| 56 | S:RGSFX'=+RGSFX RGSFX=+$O(^RGHL7(991.7,"B",RGSFX,0))
|
|---|
| 57 | Q $S(RGSFX:$P(^RGHL7(991.7,RGSFX,0),U,2),1:"")
|
|---|
| 58 | ; HL7 <==> COR flag conversion
|
|---|
| 59 | FLG(RGFLG,RGDLM,RGHL) ;
|
|---|
| 60 | N RGZ,RGC,RGR
|
|---|
| 61 | S RGHL=''$G(RGHL),RGR=""
|
|---|
| 62 | F RGZ=1:1:$S(RGHL:$L(RGFLG,RGDLM),1:$L(RGFLG)) D
|
|---|
| 63 | .S RGC=$S(RGHL:$P(RGFLG,RGDLM,RGZ),1:$E(RGFLG,RGZ))
|
|---|
| 64 | .Q:RGC=""
|
|---|
| 65 | .S RGC=$O(^RGHL7(991.2,$S(RGHL:"B",1:"AC"),RGC,0))
|
|---|
| 66 | .Q:'RGC
|
|---|
| 67 | .S RGC=$P(^RGHL7(991.2,RGC,0),U,RGHL+1)
|
|---|
| 68 | .S:RGC'="" RGR=RGR_$S(RGR="":"",RGHL:"",1:RGDLM)_RGC
|
|---|
| 69 | Q RGR
|
|---|
| 70 | ; Parse fields from RGREC into target array RGFLD using delimiter RGD.
|
|---|
| 71 | ; RGREC and RGFLD must be passed by reference.
|
|---|
| 72 | FLD(RGREC,RGFLD,RGD) ;
|
|---|
| 73 | N RGG,RGZ,RGI,RGJ,RGC
|
|---|
| 74 | K RGFLD
|
|---|
| 75 | S RGG="RGREC",RGC=0
|
|---|
| 76 | F D Q:RGG=""
|
|---|
| 77 | .S RGZ=$G(@RGG),RGJ=$L(RGZ,RGD)
|
|---|
| 78 | .F RGI=1:1:RGJ S RGFLD(RGC)=$G(RGFLD(RGC))_$P(RGZ,RGD,RGI),RGC=RGC+(RGI'=RGJ)
|
|---|
| 79 | .S RGG=$Q(@RGG)
|
|---|
| 80 | Q
|
|---|
| 81 | ; Parse MSH header
|
|---|
| 82 | MSH(RGMSH,RGARY) ;
|
|---|
| 83 | N RGZ
|
|---|
| 84 | Q:$E(RGMSH,1,3)'="MSH" 0
|
|---|
| 85 | S RGARY("FS")=$E(RGMSH,4)
|
|---|
| 86 | F RGZ=2:1:7,9:1:12 D
|
|---|
| 87 | .S RGARY($P("^ECH^SAN^SAF^RAN^RAF^DTM^^MTN^MID^PID^VER",U,RGZ))=$P(RGMSH,RGARY("FS"),RGZ)
|
|---|
| 88 | S RGZ=$E(RGARY("ECH")),RGARY("ETN")=$P(RGARY("MTN"),RGZ,2),RGARY("MTN")=$P(RGARY("MTN"),RGZ)
|
|---|
| 89 | Q 1
|
|---|
| 90 | ; Convert HL7 escape codes
|
|---|
| 91 | ESCAPE(RGTXT) ;
|
|---|
| 92 | N RGZ,RGRTN
|
|---|
| 93 | S RGRTN=""
|
|---|
| 94 | F Q:RGTXT'[RGD(4) D
|
|---|
| 95 | .S RGRTN=RGRTN_$P(RGTXT,RGD(4)),RGZ=$P(RGTXT,RGD(4),2),RGTXT=$P(RGTXT,RGD(4),3,999)
|
|---|
| 96 | .I $L(RGZ)=1 D
|
|---|
| 97 | ..S RGZ1=$F("FSRET",RGZ)-1
|
|---|
| 98 | ..S:RGZ1>0 RGRTN=RGRTN_RGD(RGZ1)
|
|---|
| 99 | .E I $E(RGZ)="X" D
|
|---|
| 100 | ..F RGZ1=2:2:$L(RGZ) S RGRTN=RGRTN_$C($$BASE^XLFUTL($E(RGZ,RGZ1,RGZ1+1),16,10))
|
|---|
| 101 | Q RGRTN_RGTXT
|
|---|
