| 1 | ORWRP4 ; slc/dcm - OE/RR HDR Report Extract Driver;9/21/05 13:21
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
|
|---|
| 3 | HDR(ROOT,HANDLE,ID) ;Extract/Modify data from the HDR
|
|---|
| 4 | ;HANDLE=Remote Broker ID in ^XTMP(HANDLE,"D",
|
|---|
| 5 | ;ID=Report ID found in field .02 file 101.24
|
|---|
| 6 | N X,ORIFN,ORID,ORCNT,ORTN,ORENT,ORRTN
|
|---|
| 7 | S ROOT=""
|
|---|
| 8 | I $G(HANDLE)="" S ROOT(0)="-1^Bad Handle" Q
|
|---|
| 9 | I '$D(^XTMP(HANDLE)) S ROOT(0)="-1^Bad Handle" Q
|
|---|
| 10 | S ORID=$O(^ORD(101.24,"AC",ID,0))
|
|---|
| 11 | I $G(ORID)="" S ROOT(0)="-1^No ID match" Q
|
|---|
| 12 | S ORCNT=$O(^ORD(101.24,ORID,3,"C",9999),-1)
|
|---|
| 13 | I $G(ORCNT)="" S ROOT(0)="-1^No Columns for Report" Q
|
|---|
| 14 | S ORTN=$P(^ORD(101.24,ORID,4),"^",6),ORENT=$P(^(4),"^",7)
|
|---|
| 15 | I '$L(ORTN) S ROOT(0)="-1^No HDR Routine exists" Q
|
|---|
| 16 | S ORRTN=ORENT_"^"_ORTN
|
|---|
| 17 | I '$L($T(@ORRTN)) S ROOT(0)="-1^HDR Routine non-existant" Q
|
|---|
| 18 | D @ORRTN
|
|---|
| 19 | Q
|
|---|
| 20 | COM(NODE,C) ;Parse Comments
|
|---|
| 21 | Q:'NODE Q:'$L($G(C))
|
|---|
| 22 | N I,J,P,D,B,DLIM,DLIM2,X
|
|---|
| 23 | S DLIM="\X0a\",DLIM2="|"
|
|---|
| 24 | 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
|
|---|
| 25 | . I $P(X," ")?8N.N1"-"4N S D=$$DATE^ORDVU($$SETDATE($P(X," "))),P=$P(X," ",2,99) D XSET(NODE_"^"_D_" "_P)
|
|---|
| 26 | . E D XSET(NODE_"^"_X)
|
|---|
| 27 | Q
|
|---|
| 28 | ESCP(C) ; De-escape text
|
|---|
| 29 | Q:'$L($G(C)) ""
|
|---|
| 30 | N HL,ORFS,ORCS,ORRS,ORES,ORSS
|
|---|
| 31 | S HL("FS")="^",HL("ECH")="~|\&"
|
|---|
| 32 | 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)
|
|---|
| 33 | Q $$REMESC(C)
|
|---|
| 34 | REMESC(ORSTR) ;
|
|---|
| 35 | ; Remove Escape Characters from HL7 Message Text
|
|---|
| 36 | ; Escape Sequence codes:
|
|---|
| 37 | ; F = field separator (ORFS)
|
|---|
| 38 | ; S = component separator (ORCS)
|
|---|
| 39 | ; R = repitition separator (ORRS)
|
|---|
| 40 | ; E = escape character (ORES)
|
|---|
| 41 | ; T = subcomponent separator (ORSS)
|
|---|
| 42 | ; Hex codes:
|
|---|
| 43 | ; Xdddd = Hex Character translated according to ISO 8859-1 character set (1st 255 characters - 8 bit)
|
|---|
| 44 | N ORC,ORREP,I1,I2,J1,J2,K,VAL
|
|---|
| 45 | 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)
|
|---|
| 46 | S ORREP("|")=" ",ORSTR=$$REPLACE^XLFSTR(ORSTR,.ORREP)
|
|---|
| 47 | F S I1=$P(ORSTR,ORES_"X") Q:$L(I1)=$L(ORSTR) D
|
|---|
| 48 | . S I2=$P(ORSTR,ORES_"X",2,99),J1=$P(I2,ORES)
|
|---|
| 49 | . Q:'$L(J1)
|
|---|
| 50 | . 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
|
|---|
| 51 | Q ORSTR
|
|---|
| 52 | XSET(X) ;Setup Allergy & Outpatient RX nodes
|
|---|
| 53 | Q:'$D(X)
|
|---|
| 54 | S CNT=CNT+1,^TMP("ORXS1",$J,CNT)=$$ESCP(X)
|
|---|
| 55 | Q
|
|---|
| 56 | SETDATE(X) ;Convert HDR Date to FM date
|
|---|
| 57 | Q:'$D(X) ""
|
|---|
| 58 | Q:'$L(X) ""
|
|---|
| 59 | N YEAR,DAY,MONTH,TIME,DOT
|
|---|
| 60 | S YEAR=$E(X,1,4)-1700,MONTH=$E(X,5,6),DAY=$E(X,7,8),TIME=$E(X,9,14),DOT="."
|
|---|
| 61 | I TIME="0000"!(TIME="") S DOT="",TIME=""
|
|---|
| 62 | S X=YEAR_MONTH_DAY_DOT_TIME
|
|---|
| 63 | Q X
|
|---|
