ORWRP4 ; slc/dcm - OE/RR HDR Report Extract Driver;9/21/05 13:21
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
HDR(ROOT,HANDLE,ID) ;Extract/Modify data from the HDR
;HANDLE=Remote Broker ID in ^XTMP(HANDLE,"D",
;ID=Report ID found in field .02 file 101.24
N X,ORIFN,ORID,ORCNT,ORTN,ORENT,ORRTN
S ROOT=""
I $G(HANDLE)="" S ROOT(0)="-1^Bad Handle" Q
I '$D(^XTMP(HANDLE)) S ROOT(0)="-1^Bad Handle" Q
S ORID=$O(^ORD(101.24,"AC",ID,0))
I $G(ORID)="" S ROOT(0)="-1^No ID match" Q
S ORCNT=$O(^ORD(101.24,ORID,3,"C",9999),-1)
I $G(ORCNT)="" S ROOT(0)="-1^No Columns for Report" Q
S ORTN=$P(^ORD(101.24,ORID,4),"^",6),ORENT=$P(^(4),"^",7)
I '$L(ORTN) S ROOT(0)="-1^No HDR Routine exists" Q
S ORRTN=ORENT_"^"_ORTN
I '$L($T(@ORRTN)) S ROOT(0)="-1^HDR Routine non-existant" Q
D @ORRTN
Q
COM(NODE,C) ;Parse Comments
Q:'NODE Q:'$L($G(C))
N I,J,P,D,B,DLIM,DLIM2,X
S DLIM="\X0a\",DLIM2="|"
F I=1:1:$L(C,DLIM) S B=$P(C,DLIM,I) F J=1:1:$L(B,DLIM2) S X=$P(B,DLIM2,J),D="" D
. I $P(X," ")?8N.N1"-"4N S D=$$DATE^ORDVU($$SETDATE($P(X," "))),P=$P(X," ",2,99) D XSET(NODE_"^"_D_" "_P)
. E D XSET(NODE_"^"_X)
Q
ESCP(C) ; De-escape text
Q:'$L($G(C)) ""
N HL,ORFS,ORCS,ORRS,ORES,ORSS
S HL("FS")="^",HL("ECH")="~|\&"
S ORFS=$G(HL("FS")),ORCS=$E($G(HL("ECH")),1),ORRS=$E($G(HL("ECH")),2),ORES=$E($G(HL("ECH")),3),ORSS=$E($G(HL("ECH")),4)
Q $$REMESC(C)
REMESC(ORSTR) ;
; Remove Escape Characters from HL7 Message Text
; Escape Sequence codes:
; F = field separator (ORFS)
; S = component separator (ORCS)
; R = repitition separator (ORRS)
; E = escape character (ORES)
; T = subcomponent separator (ORSS)
; Hex codes:
; Xdddd = Hex Character translated according to ISO 8859-1 character set (1st 255 characters - 8 bit)
N ORC,ORREP,I1,I2,J1,J2,K,VAL
F ORC="F","S","R","E","T" S ORREP(ORES_ORC_ORES)=$S(ORC="F":ORFS,ORC="S":ORCS,ORC="R":ORRS,ORC="E":ORES,ORC="T":ORSS)
S ORREP("|")=" ",ORSTR=$$REPLACE^XLFSTR(ORSTR,.ORREP)
F S I1=$P(ORSTR,ORES_"X") Q:$L(I1)=$L(ORSTR) D
. S I2=$P(ORSTR,ORES_"X",2,99),J1=$P(I2,ORES)
. Q:'$L(J1)
. S J2=$P(I2,ORES,2,99),VAL=$$BASE^XLFUTL($$UP^XLFSTR(J1),16,10),K=$S(VAL>255:"?",1:$C(VAL)),ORSTR=I1_K_J2
Q ORSTR
XSET(X) ;Setup Allergy & Outpatient RX nodes
Q:'$D(X)
S CNT=CNT+1,^TMP("ORXS1",$J,CNT)=$$ESCP(X)
Q
SETDATE(X) ;Convert HDR Date to FM date
Q:'$D(X) ""
Q:'$L(X) ""
N YEAR,DAY,MONTH,TIME,DOT
S YEAR=$E(X,1,4)-1700,MONTH=$E(X,5,6),DAY=$E(X,7,8),TIME=$E(X,9,14),DOT="."
I TIME="0000"!(TIME="") S DOT="",TIME=""
S X=YEAR_MONTH_DAY_DOT_TIME
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWRP4 2615 printed Sep 23, 2025@20:13:40 Page 2
ORWRP4 ; slc/dcm - OE/RR HDR Report Extract Driver;9/21/05 13:21
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
HDR(ROOT,HANDLE,ID) ;Extract/Modify data from the HDR
+1 ;HANDLE=Remote Broker ID in ^XTMP(HANDLE,"D",
+2 ;ID=Report ID found in field .02 file 101.24
+3 NEW X,ORIFN,ORID,ORCNT,ORTN,ORENT,ORRTN
+4 SET ROOT=""
+5 IF $GET(HANDLE)=""
SET ROOT(0)="-1^Bad Handle"
QUIT
+6 IF '$DATA(^XTMP(HANDLE))
SET ROOT(0)="-1^Bad Handle"
QUIT
+7 SET ORID=$ORDER(^ORD(101.24,"AC",ID,0))
+8 IF $GET(ORID)=""
SET ROOT(0)="-1^No ID match"
QUIT
+9 SET ORCNT=$ORDER(^ORD(101.24,ORID,3,"C",9999),-1)
+10 IF $GET(ORCNT)=""
SET ROOT(0)="-1^No Columns for Report"
QUIT
+11 SET ORTN=$PIECE(^ORD(101.24,ORID,4),"^",6)
SET ORENT=$PIECE(^(4),"^",7)
+12 IF '$LENGTH(ORTN)
SET ROOT(0)="-1^No HDR Routine exists"
QUIT
+13 SET ORRTN=ORENT_"^"_ORTN
+14 IF '$LENGTH($TEXT(@ORRTN))
SET ROOT(0)="-1^HDR Routine non-existant"
QUIT
+15 DO @ORRTN
+16 QUIT
COM(NODE,C) ;Parse Comments
+1 if 'NODE
QUIT
if '$LENGTH($GET(C))
QUIT
+2 NEW I,J,P,D,B,DLIM,DLIM2,X
+3 SET DLIM="\X0a\"
SET DLIM2="|"
+4 FOR I=1:1:$LENGTH(C,DLIM)
SET B=$PIECE(C,DLIM,I)
FOR J=1:1:$LENGTH(B,DLIM2)
SET X=$PIECE(B,DLIM2,J)
SET D=""
Begin DoDot:1
+5 IF $PIECE(X," ")?8N.N1"-"4N
SET D=$$DATE^ORDVU($$SETDATE($PIECE(X," ")))
SET P=$PIECE(X," ",2,99)
DO XSET(NODE_"^"_D_" "_P)
+6 IF '$TEST
DO XSET(NODE_"^"_X)
End DoDot:1
+7 QUIT
ESCP(C) ; De-escape text
+1 if '$LENGTH($GET(C))
QUIT ""
+2 NEW HL,ORFS,ORCS,ORRS,ORES,ORSS
+3 SET HL("FS")="^"
SET HL("ECH")="~|\&"
+4 SET ORFS=$GET(HL("FS"))
SET ORCS=$EXTRACT($GET(HL("ECH")),1)
SET ORRS=$EXTRACT($GET(HL("ECH")),2)
SET ORES=$EXTRACT($GET(HL("ECH")),3)
SET ORSS=$EXTRACT($GET(HL("ECH")),4)
+5 QUIT $$REMESC(C)
REMESC(ORSTR) ;
+1 ; Remove Escape Characters from HL7 Message Text
+2 ; Escape Sequence codes:
+3 ; F = field separator (ORFS)
+4 ; S = component separator (ORCS)
+5 ; R = repitition separator (ORRS)
+6 ; E = escape character (ORES)
+7 ; T = subcomponent separator (ORSS)
+8 ; Hex codes:
+9 ; Xdddd = Hex Character translated according to ISO 8859-1 character set (1st 255 characters - 8 bit)
+10 NEW ORC,ORREP,I1,I2,J1,J2,K,VAL
+11 FOR ORC="F","S","R","E","T"
SET ORREP(ORES_ORC_ORES)=$SELECT(ORC="F":ORFS,ORC="S":ORCS,ORC="R":ORRS,ORC="E":ORES,ORC="T":ORSS)
+12 SET ORREP("|")=" "
SET ORSTR=$$REPLACE^XLFSTR(ORSTR,.ORREP)
+13 FOR
SET I1=$PIECE(ORSTR,ORES_"X")
if $LENGTH(I1)=$LENGTH(ORSTR)
QUIT
Begin DoDot:1
+14 SET I2=$PIECE(ORSTR,ORES_"X",2,99)
SET J1=$PIECE(I2,ORES)
+15 if '$LENGTH(J1)
QUIT
+16 SET J2=$PIECE(I2,ORES,2,99)
SET VAL=$$BASE^XLFUTL($$UP^XLFSTR(J1),16,10)
SET K=$SELECT(VAL>255:"?",1:$CHAR(VAL))
SET ORSTR=I1_K_J2
End DoDot:1
+17 QUIT ORSTR
XSET(X) ;Setup Allergy & Outpatient RX nodes
+1 if '$DATA(X)
QUIT
+2 SET CNT=CNT+1
SET ^TMP("ORXS1",$JOB,CNT)=$$ESCP(X)
+3 QUIT
SETDATE(X) ;Convert HDR Date to FM date
+1 if '$DATA(X)
QUIT ""
+2 if '$LENGTH(X)
QUIT ""
+3 NEW YEAR,DAY,MONTH,TIME,DOT
+4 SET YEAR=$EXTRACT(X,1,4)-1700
SET MONTH=$EXTRACT(X,5,6)
SET DAY=$EXTRACT(X,7,8)
SET TIME=$EXTRACT(X,9,14)
SET DOT="."
+5 IF TIME="0000"!(TIME="")
SET DOT=""
SET TIME=""
+6 SET X=YEAR_MONTH_DAY_DOT_TIME
+7 QUIT X
