- 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
- 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
