Changeset 636 for FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLRPT.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLRPT.m
r628 r636 1 1 RAHLRPT ;HISC/CAH AISC/SAW-Compiles HL7 'ORU' Message Type ; 4/26/01 10:40am 2 ;;5.0;Radiology/Nuclear Medicine;**2,12,10,25,81,80 ,84**;Mar 16, 1998;Build 132 ;;5.0;Radiology/Nuclear Medicine;**2,12,10,25,81,80**;Mar 16, 1998;Build 19 3 3 EN ; Called from RA RPT and RA RPT 2.3 protocol entry action 4 4 ; Input variables: … … 10 10 ; Output variables: 11 11 ; HLA("HLS", array containing HL7 msg 12 ; RATELREL = 1 Indicates that the text: 'Released for local dictation by National Teleradiology'13 ; has been included in Impression or Report section14 ; RATELX = Text used as indication of Release for local dictation... if not set use defauld above...15 ; RATELE = 1 If RANOSEND is Teleradiology type vendor16 12 ; 17 ;Integration Agreements 18 ;---------------------- 19 ;$$GET1^DIQ(2056); ^DIWP(10011); $$HLDATE/$$HLNAME^HLFNC(10106) 20 ;GENERATE^HLMA(2164); DEM^VADPT(10061); $$FMTHL7^XLFDT(10103) 21 ;$$PATCH^XPDUTL(10141); $$VERSION^XPDUTL(10141) 22 ; 23 N RASET,RACN0,RATELE,RATELREL,RATELX 24 D INIT^RAHLRPTT ;Patch 84 13 N RASET,RACN0 14 S RASET=0 15 S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) 16 S:'$D(RARPT) RARPT=+$P(RACN0,"^",17) 25 17 I +$P(RACN0,U,25)=2 D Q ; printset 26 18 .; loop through all cases in set and create message … … 37 29 D INIT^RAHLRU ;initialize HL7 variables 38 30 Q:+$G(HL)=15 ;no known client(item) linked to the event driver protocol 39 Q:$O(HL(""))="" ;failed return from INIT^HLFNC2 (called by INIT^RAHLRU)31 Q:$O(HL(""))="" ;failed return from init^hlfnc2 40 32 ; 41 33 ;** branch to new HL7 logic when the HL7 version surpasses 2.3 ** 42 I HL("VER")>2.3,($T(^RAHLRPT1))'=""D EN^RAHLRPT1(RADFN,RADTI,RACNI,RAEID),EXIT Q34 ;I HL("VER")]2.3 D EN^RAHLRPT1(RADFN,RADTI,RACNI,RAEID),EXIT Q 43 35 ;** branch to new HL7 logic when the HL7 version surpasses 2.3 ** 44 36 ; … … 49 41 ; for an inexact date of birth. If inexact, pass null for DOB in 50 42 ; the 'PID' segment. Some COTS systems can't handle inexact DOB's. 51 D SETUP ^RAHLRPTT,PID^RAHLRPTT,OBR,OBXPRC,OBXIMP,OBXDIA,OBXRPT,OBXMOD,OBXTCM43 D SETUP,PID,OBR,OBXPRC,OBXIMP,OBXDIA,OBXRPT,OBXMOD,OBXTCM 52 44 EXIT ; set HL7 message type & return to RA RPT protocol 53 ;For P84 see if this is a >>Released for local reading<< type report and if yes resend the ORM (^RAHLRS1)...54 I $G(RATELREL) D RESEND^RAHLRPTT(RADFN,RADTI,RACNI) Q ;P84 resend in the case that report released from Telerad55 45 S HL("MTN")="ORU" 56 46 N HLEID,HLARYTYP,HLFORMAT,HLMTIEN,HLP 57 47 S HLEID=RAEID,HLARYTYP="LM",HLFORMAT=1,HLMTIEN="",HLP("PRIORITY")="I" 58 48 M:$D(RASSS) HLP=RASSS 59 D:$D(RASSSX(HLEID)) GETHLP^RAHLRS1(HLEID,.HLP ,"RASSSX")49 D:$D(RASSSX(HLEID)) GETHLP^RAHLRS1(HLEID,.HLP) 60 50 D GENERATE^HLMA(HLEID,HLARYTYP,HLFORMAT,.HLRESLT,HLMTIEN,.HLP) 61 51 K RAVADM … … 102 92 S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D 103 93 .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q 104 .S X2=$ P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)),"^",1) I X2']"" Q94 .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q 105 95 .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']"" 106 96 .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q … … 108 98 ;Transcriptionist 109 99 S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D 110 .S X2=$$GET1^DIQ(200, $P(^RARPT(RARPT,"T"),"^",1),.01) I X2']"" Q100 .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q 111 101 .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q 112 102 .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y 113 103 ; 114 104 ; if long str, break so 2nd str begins with separator to avoid abend 115 N RAPART I $L(X1)>245F RAPART=5:1:18 S RAPART(1)=$P(X1,HLFS,1,RAPART),RAPART(2)=$P(X1,HLFS,RAPART+1,99) Q:$L(RAPART(1))<245&($L(RAPART(2))<245)&($P(RAPART(2),HLFS)="")105 I $L(X1)>245 N RAPART F RAPART=5:1:18 S RAPART(1)=$P(X1,HLFS,1,RAPART),RAPART(2)=$P(X1,HLFS,RAPART+1,99) Q:$L(RAPART(1))<245&($L(RAPART(2))<245)&($P(RAPART(2),HLFS)="") 116 106 I $D(RAPART) K:RAPART=18 RAPART ;if RAPART reaches 18, then something's wrong, so kill RAPART to allow abend due "string too long" 117 107 S RAN=RAN+1 … … 146 136 OBXIMP ;Compile 'OBX' segment for Impression 147 137 I '$O(^RARPT(RARPT,"I",0)) S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_"I"_$E(HLECH)_"IMPRESSION"_$E(HLECH)_"L"_HLFS_HLFS_"None Entered" D OBX11^RAHLRU Q 148 K ^UTILITY($J,"W") S DIWF="",DIWR=80,DIWL=1 149 F RAI=0:0 S RAI=$O(^RARPT(RARPT,"I",RAI)) Q:'RAI I $D(^(RAI,0)) S X=^(0) D RATELREL,^DIWP 138 K ^UTILITY($J,"W") S DIWF="",DIWR=80,DIWL=1 F RAI=0:0 S RAI=$O(^RARPT(RARPT,"I",RAI)) Q:'RAI I $D(^(RAI,0)) S X=^(0) D ^DIWP 150 139 F RAI=0:0 S RAI=$O(^UTILITY($J,"W",DIWL,RAI)) Q:'RAI I $D(^(RAI,0)) S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_"I"_$E(HLECH)_"IMPRESSION"_$E(HLECH)_"L"_HLFS_HLFS_^(0) D OBX11^RAHLRU 151 140 Q … … 156 145 S RAN=RAN+1 D OBXPRC^RAHLRU 157 146 Q 158 OBXTCM ; Compile 'OBX' Segment for Tech Comments147 OBXTCM ; Compile 'OBX' Segment for Tech Comments 159 148 D OBXTCM^RAHLRU 160 149 Q 161 150 OBXRPT ;Compile 'OBX' Segment for Radiology Report Text 162 151 I '$O(^RARPT(RARPT,"R",0)) S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_"R"_$E(HLECH)_"REPORT"_$E(HLECH)_"L"_HLFS_HLFS_"None Entered" D OBX11^RAHLRU Q 163 K ^UTILITY($J,"W") S DIWF="",DIWR=80,DIWL=1 164 F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI I $D(^(RAI,0)) S X=^(0) D RATELREL,^DIWP 152 K ^UTILITY($J,"W") S DIWF="",DIWR=80,DIWL=1 F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI I $D(^(RAI,0)) S X=^(0) D ^DIWP 165 153 F RAI=0:0 S RAI=$O(^UTILITY($J,"W",DIWL,RAI)) Q:'RAI I $D(^(RAI,0)) S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_"R"_$E(HLECH)_"REPORT"_$E(HLECH)_"L"_HLFS_HLFS_^(0) D OBX11^RAHLRU 166 154 ; Replace above with following when Imaging can cope with ESC chars 167 155 ; F RAI=0:0 S RAI=$O(^UTILITY($J,"W",DIWL,RAI)) Q:'RAI I $D(^(RAI,0)) S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_"R"_$E(HLECH)_"REPORT"_$E(HLECH)_"L"_HLFS_HLFS_$$ESCAPE^RAHLRU(^(0)) D OBX11^RAHLRU 168 156 Q 169 RATELREL ;Release the study for local reading 170 I $G(RATELE),X[$G(RATELX) S RATELREL=1 Q 171 ; 157 PID ;Compile 'PID' Segment 158 I HL("VER")']"2.2" D 159 .S X1="",X1="PID"_HLFS_HLFS_$G(VA("PID"))_HLFS_Y_HLFS_HLFS S X=VADM(1),Y=$$HLNAME^HLFNC(X) S X1=X1_Y_HLFS_HLFS 160 .S X=RAVADM(3),Y=$$HLDATE^HLFNC(X) S X1=X1_Y_HLFS_$S(VADM(5)]"":$S("MF"[$P(VADM(5),"^"):$P(VADM(5),"^"),1:"O"),1:"U") S:$P(VADM(2),"^")]"" $P(X1,HLFS,20)=$P(VADM(2),"^") S RAN=RAN+1,HLA("HLS",RAN)=X1 161 I HL("VER")]"2.2" S RAN=RAN+1,HLA("HLS",RAN)=$$EN^VAFHLPID(DFN,"2,3,5,7,8,19,20") 162 Q 163 SETUP ; Setup basic examination information 164 S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) 165 S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,0) 166 S RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1) 167 S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9) 168 S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT) 169 S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN) 170 Q
Note:
See TracChangeset
for help on using the changeset viewer.