source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWRP4.m@ 813

Last change on this file since 813 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1ORWRP4 ; slc/dcm - OE/RR HDR Report Extract Driver;9/21/05 13:21
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
3HDR(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
20COM(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
28ESCP(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)
34REMESC(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
52XSET(X) ;Setup Allergy & Outpatient RX nodes
53 Q:'$D(X)
54 S CNT=CNT+1,^TMP("ORXS1",$J,CNT)=$$ESCP(X)
55 Q
56SETDATE(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
Note: See TracBrowser for help on using the repository browser.