source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLBKVR.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1RAHLBKVR ;HIRMFO/GJC-Bridge, Kurzweil compatible to HL7 v1.5 ;12/31/97 12:05
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3EN1 ; Build the ^TMP("RARPT-REC" global when we
4 ; receive the message from HL7.
5 ; HLDA-ien of the record in ^HL(772, should be defined.
6 K ^TMP("RARPT-REC",$J) S RASUB=HLDA
7 I '$G(HLDUZ) S RAERR="Invalid Access Code" D XIT Q
8 S ^TMP("RARPT-REC",$J,RASUB,"RADATE")=$$DT^XLFDT()
9 S ^TMP("RARPT-REC",$J,RASUB,"VENDOR")="KURZWEIL"
10 ;If OBR-32 exists use it as verifying phys even if HLDUZ has resident
11 ; or staff classif
12 S CNT=2,SEGMNT=$G(^HL(772,RASUB,"IN",CNT,0))
13PID ; Pick data off the 'PID' segment.
14 I $P(SEGMNT,HLFS)="PID" D
15 . S SEGMNT=$P(SEGMNT,HLFS,2,99999)
16 . I $P($P(SEGMNT,HLFS,3),$E(HLECH))]"" D
17 .. S ^TMP("RARPT-REC",$J,RASUB,"RADFN")=$P($P(SEGMNT,HLFS,3),$E(HLECH))
18 .. Q
19 . I $P(SEGMNT,HLFS,19)]"" D
20 .. S ^TMP("RARPT-REC",$J,RASUB,"RASSN")=$P(SEGMNT,HLFS,19)
21 .. Q
22 . Q
23 E S RAERR="Missing PID segment" D XIT Q
24 ; Save off E-Sig information (if it exists)
25 S:$D(HLESIG) ^TMP("RARPT-REC",$J,RASUB,"RAESIG")=HLESIG
26 ;
27OBR ; Pick data off the 'OBR' segment.
28 K SEGMNT F S CNT=$O(^HL(772,RASUB,"IN",CNT)) Q:CNT="" S SEGMNT=$G(^(CNT,0)) Q:$P(SEGMNT,HLFS)="OBR" ; find the 'OBR' segment
29 I $P($G(SEGMNT),HLFS)'="OBR" S RAERR="Missing OBR segment" D XIT Q
30 S SEGMNT=$P(SEGMNT,HLFS,2,99999)
31 I $P(SEGMNT,HLFS,4)]"" D
32 . N RADTCN S RADTCN=$P(SEGMNT,HLFS,4)
33 . S:$P($P(RADTCN,$E(HLECH)),"-")]"" ^TMP("RARPT-REC",$J,RASUB,"RADTI")=$P($P(RADTCN,$E(HLECH)),"-")
34 . S:$P($P(RADTCN,$E(HLECH)),"-",2)]"" ^TMP("RARPT-REC",$J,RASUB,"RACNI")=$P($P(RADTCN,$E(HLECH)),"-",2)
35 . S:$P(RADTCN,$E(HLECH),2)]"" ^TMP("RARPT-REC",$J,RASUB,"RALONGCN")=$P(RADTCN,$E(HLECH),2)
36 . Q
37 ; note: must use $D on hlesig, as it's alphanumeric
38 S ^TMP("RARPT-REC",$J,RASUB,"RASTAT")=$S($D(HLESIG):"V",1:"P")
39 I $P(SEGMNT,HLFS,16)']"" S RAERR="Missing Provider ID" D XIT Q
40 S ^TMP("RARPT-REC",$J,RASUB,"RAVERF")=$S($D(HLESIG):HLDUZ,1:"")
41 S ^TMP("RARPT-REC",$J,RASUB,"RATRANSCRIPT")=$G(HLDUZ)
42 S ^TMP("RARPT-REC",$J,RASUB,"RASTAFF")=$S(+$P(SEGMNT,HLFS,32):+$P(SEGMNT,HLFS,32),1:$G(HLDUZ))
43 S ^TMP("RARPT-REC",$J,RASUB,"RARESIDENT")=$S(+$P(SEGMNT,HLFS,33):+$P(SEGMNT,HLFS,33),1:"")
44 S ^TMP("RARPT-REC",$J,RASUB,"RAWHOCHANGE")=$G(HLDUZ)
45 ;
46OBX ; Pick data off the 'OBX' segments
47 K SEGMNT F S CNT=$O(^HL(772,RASUB,"IN",CNT)) Q:CNT="" S SEGMNT=$G(^(CNT,0)) D:$P(SEGMNT,HLFS)="OBX" Q:$D(RAERR)
48 . S SEGMNT=$P(SEGMNT,HLFS,2,9999)
49 . I $P(SEGMNT,HLFS,3)']"" S RAERR="Missing Observation Identifier" Q
50 . S OBXTYP=$P($P(SEGMNT,HLFS,3),$E(HLECH))
51 . I "IDR"'[OBXTYP S RAERR="Invalid Observation Identifier" Q
52 . D:OBXTYP="I" IMP D:OBXTYP="R" RPT D:OBXTYP="D" DIAG
53 . Q
54XIT ; Clean up environment, quit
55 I $D(^TMP("RARPT-REC",$J,RASUB)),('$D(RAERR)) D EN1^RAHLO
56 K ^TMP("RARPT-REC",$J,RASUB)
57 ; Compile the 'ACK' segment
58 I $D(RAERR) S X1=HLSDATA(1) K HLSDATA S HLSDATA(1)=X1,HLERR=RAERR
59 S HLMTN="ACK",HLSDATA(2)="MSA"_HLFS_$S($D(HLERR):"AE",1:"AA")_HLFS_HLMID_$S($D(HLERR):HLFS_HLERR,1:"")
60 D:$D(HLTRANS) EN1^HLTRANS K CNT,OBXTYPE
61 K RADATE,RADCNT,RADTCN,RAERR,RAESIG,RAICNT,RARCNT,RASUB,RAVERF,SEGMNT
62 K RATRANSC,RAPRIMAR
63 Q
64DIAG ; Save off Diagnostic Code data.
65 S RADCNT=+$G(RADCNT)+1
66 I $P(SEGMNT,HLFS,5)]"" D ; strip off leading spaces, save Dx code
67 . N DXSTR,X ; DXSTR=Dx code entered by user, X=char pos following space
68 . S DXSTR=$P(SEGMNT,HLFS,5)
69 . F S X=$F(DXSTR," ") Q:X'=2 S DXSTR=$E(DXSTR,X,999)
70 . S ^TMP("RARPT-REC",$J,RASUB,"RADX",RADCNT)=DXSTR
71 . Q
72 Q
73IMP ; Save off Impression Text data.
74 S RAICNT=+$G(RAICNT)+1
75 S ^TMP("RARPT-REC",$J,RASUB,"RAIMP",RAICNT)=$P(SEGMNT,HLFS,5)
76 Q
77RPT ; Save off Report Text data.
78 S RARCNT=+$G(RARCNT)+1
79 S ^TMP("RARPT-REC",$J,RASUB,"RATXT",RARCNT)=$P(SEGMNT,HLFS,5)
80 Q
Note: See TracBrowser for help on using the repository browser.