- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLRPT.m
r613 r623 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 13 3 EN ; Called from RA RPT and RA RPT 2.3 protocol entry action 4 ; Input variables: 5 ; RADFN=file 2 IEN (DFN) 6 ; RADTI=file 70 Exam subrecord IEN (reverse date/time) 7 ; RACNI=file 70 Case subrecord IEN 8 ; RARPT=file 74 Report IEN 9 ; RASSS=List of Subscribers passed into GENERATE^HLMA will be set into HLP array. 10 ; Output variables: 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 section 14 ; RATELX = Text used as indication of Release for local dictation... if not set use defauld above... 15 ; RATELE = 1 If RANOSEND is Teleradiology type vendor 16 ; 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 25 I +$P(RACN0,U,25)=2 D Q ; printset 26 .; loop through all cases in set and create message 27 .S RASET=1 28 .N RACNI,RAII S RAII=0 29 .F S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0 D 30 .. Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2 31 .. S RACNI=RAII 32 .. D NEW 33 NEW ; new variables 34 S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global 35 N DFN,DIWF,DIWL,DIWR,RACPT,RACPTNDE,RADTECN,RADTE0,RADTV,RAI,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RARPT0 36 N VADM,VAERR,X,X1,X2,XX2,Y,X0,OBR36,EID,HL,INT,HLQ,HLFS,HLECH,HLA,RAN K RAVADM 37 D INIT^RAHLRU ;initialize HL7 variables 38 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) 40 ; 41 ;** 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 Q 43 ;** branch to new HL7 logic when the HL7 version surpasses 2.3 ** 44 ; 45 S DFN=RADFN D DEM^VADPT 46 I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT 47 S RAN=0 48 S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3)) ; NOTE: Check 49 ; for an inexact date of birth. If inexact, pass null for DOB in 50 ; the 'PID' segment. Some COTS systems can't handle inexact DOB's. 51 D SETUP^RAHLRPTT,PID^RAHLRPTT,OBR,OBXPRC,OBXIMP,OBXDIA,OBXRPT,OBXMOD,OBXTCM 52 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 Telerad 55 S HL("MTN")="ORU" 56 N HLEID,HLARYTYP,HLFORMAT,HLMTIEN,HLP 57 S HLEID=RAEID,HLARYTYP="LM",HLFORMAT=1,HLMTIEN="",HLP("PRIORITY")="I" 58 M:$D(RASSS) HLP=RASSS 59 D:$D(RASSSX(HLEID)) GETHLP^RAHLRS1(HLEID,.HLP,"RASSSX") 60 D GENERATE^HLMA(HLEID,HLARYTYP,HLFORMAT,.HLRESLT,HLMTIEN,.HLP) 61 K RAVADM 62 Q 63 ; 64 OBR ;Compile 'OBR' Segment 65 S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$P(RACPTNDE,U,2)_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP" 66 ; Replace above with following when Imaging can cope with ESC chars 67 ; S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$$ESCAPE^RAHLRU($P(RACPTNDE,U,2))_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$$ESCAPE^RAHLRU($P(RAPRCNDE,U))_$E(HLECH)_"99RAP" 68 ; Have to use LOCAL code if Broad Procedure - no CPT code 69 I $P(RAOBR4,$E(HLECH))=""!($P(RAOBR4,$E(HLECH),2)="") S $P(RAOBR4,$E(HLECH),1,3)=$P(RAOBR4,$E(HLECH),4,5)_$E(HLECH)_"LOCAL" 70 S X1="OBR"_HLFS_HLFS_HLFS_RADTI_"-"_RACNI_$E(HLECH)_RADTECN_$E(HLECH)_"L"_HLFS_RAOBR4_HLFS_HLFS_HLFS_RADTE0_HLFS_HLQ_HLFS_HLQ_HLFS_HLFS_HLFS_HLFS_HLFS,Y=$$HLDATE^HLFNC($P(RARPT0,"^",6)) S X1=X1_Y_HLFS_HLFS 71 S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01) 72 S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"") 73 S $P(X1,HLFS,19)=$S($D(^DIC(42,+$P(RACN0,"^",6),0)):$P(^(0),"^"),$D(^SC(+$P(RACN0,"^",8),0)):$P(^(0),"^"),1:"Unknown") 74 ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name 75 N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0)) 76 S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0)) 77 S $P(X1,HLFS,21)=$P(RACN00,"^",4)_$E(HLECH)_$P($G(^SC(RA20,0)),"^")_$E(HLECH)_$P(RACN00,"^",3)_$E(HLECH)_$P($G(^DIC(4,$P(RACN00,U,3),0)),"^") 78 S $P(X1,HLFS,21)=$P(X1,HLFS,21) 79 ; Replace above with following when Imaging can cope with ESC chars 80 ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21)) 81 ; 82 S OBR36=9999999.9999-RADTI 83 S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36) 84 ; 85 S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7)) 86 S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R") 87 ;Principal Result Interpreter = Verifying Physician 88 S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D 89 .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']"" 90 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 91 .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y 92 ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident 93 S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D 94 .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']"" 95 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 96 .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y 97 I $P(RACN0,"^",12) D 98 .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']"" 99 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 100 .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y 101 ;Technician = Technologist 102 S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D 103 .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']"" Q 105 .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']"" 106 .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q 107 .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y 108 ;Transcriptionist 109 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']"" Q 111 .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q 112 .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y 113 ; 114 ; if long str, break so 2nd str begins with separator to avoid abend 115 N RAPART I $L(X1)>245 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 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 S RAN=RAN+1 118 I $D(RAPART) S HLA("HLS",RAN)=$P(RAPART(1),HLFS)_HLFS,HLA("HLS",RAN,1)=$P(RAPART(1),HLFS,2,99)_HLFS,HLA("HLS",RAN,2)=RAPART(2) K RAPART Q 119 S HLA("HLS",RAN)=X1 120 Q 121 OBXDIA ;Compile 'OBX' Segment for Diagnostic Code 122 S RAI=$P($G(^RA(78.3,+$P(RACN0,"^",13),0)),"^") I RAI]"" D 123 .S RAN=RAN+1 124 .I $$PATCH^XPDUTL("MAG*2.5*1")!(+$$VERSION^XPDUTL("MAG")>2.5) D 125 ..S HLA("HLS",RAN)="OBX"_HLFS_HLFS_"CE"_HLFS_"D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L"_HLFS_HLFS_+$P(RACN0,"^",13)_$E(HLECH)_RAI_$E(HLECH)_"L" 126 ..; Replace above with following when Imaging can cope with ESC chars 127 ..; S HLA("HLS",RAN)="OBX"_HLFS_HLFS_"CE"_HLFS_"D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L"_HLFS_HLFS_+$P(RACN0,"^",13)_$E(HLECH)_$$ESCAPE^RAHLRU(RAI)_$E(HLECH)_"L" 128 .E D 129 ..S HLA("HLS",RAN)="OBX"_HLFS_HLFS_"ST"_HLFS_"D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L"_HLFS_HLFS_RAI 130 .D OBX11^RAHLRU 131 Q:'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)) ;any secondary dx 132 S X2=0 133 OBXDIA2 S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",X2)) Q:'X2 134 S Y=+^(X2,0),X=$P($G(^RA(78.3,+Y,0)),U) 135 I X]"" D 136 .S RAN=RAN+1 137 .I $$PATCH^XPDUTL("MAG*2.5*1")!(+$$VERSION^XPDUTL("MAG")>2.5) D 138 ..S HLA("HLS",RAN)="OBX"_HLFS_HLFS_"CE"_HLFS_"D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L"_HLFS_HLFS_Y_$E(HLECH)_X_$E(HLECH)_"L" 139 ..; Replace above with following when Imaging can cope with ESC chars 140 ..; S HLA("HLS",RAN)="OBX"_HLFS_HLFS_"CE"_HLFS_"D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L"_HLFS_HLFS_Y_$E(HLECH)_$$ESCAPE^RAHLRU(X)_$E(HLECH)_"L" 141 .E D 142 ..S HLA("HLS",RAN)="OBX"_HLFS_HLFS_"ST"_HLFS_"D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L"_HLFS_HLFS_X 143 .D OBX11^RAHLRU 144 G OBXDIA2 145 ; 146 OBXIMP ;Compile 'OBX' segment for Impression 147 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 150 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 Q 152 OBXMOD ;Compile 'OBX' Segment for Modifiers 153 S RAN=RAN+1 D OBXMOD^RAHLRU 154 Q 155 OBXPRC ;Compile 'OBX' Segment for Procedure 156 S RAN=RAN+1 D OBXPRC^RAHLRU 157 Q 158 OBXTCM ;Compile 'OBX' Segment for Tech Comments 159 D OBXTCM^RAHLRU 160 Q 161 OBXRPT ;Compile 'OBX' Segment for Radiology Report Text 162 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 165 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 ; Replace above with following when Imaging can cope with ESC chars 167 ; 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 Q 169 RATELREL ;Release the study for local reading 170 I $G(RATELE),X[$G(RATELX) S RATELREL=1 Q 171 ; 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**;Mar 16, 1998;Build 19 3 EN ; Called from RA RPT and RA RPT 2.3 protocol entry action 4 ; Input variables: 5 ; RADFN=file 2 IEN (DFN) 6 ; RADTI=file 70 Exam subrecord IEN (reverse date/time) 7 ; RACNI=file 70 Case subrecord IEN 8 ; RARPT=file 74 Report IEN 9 ; RASSS=List of Subscribers passed into GENERATE^HLMA will be set into HLP array. 10 ; Output variables: 11 ; HLA("HLS", array containing HL7 msg 12 ; 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) 17 I +$P(RACN0,U,25)=2 D Q ; printset 18 .; loop through all cases in set and create message 19 .S RASET=1 20 .N RACNI,RAII S RAII=0 21 .F S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0 D 22 .. Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2 23 .. S RACNI=RAII 24 .. D NEW 25 NEW ; new variables 26 S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global 27 N DFN,DIWF,DIWL,DIWR,RACPT,RACPTNDE,RADTECN,RADTE0,RADTV,RAI,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RARPT0 28 N VADM,VAERR,X,X1,X2,XX2,Y,X0,OBR36,EID,HL,INT,HLQ,HLFS,HLECH,HLA,RAN K RAVADM 29 D INIT^RAHLRU ;initialize HL7 variables 30 Q:+$G(HL)=15 ;no known client(item) linked to the event driver protocol 31 Q:$O(HL(""))="" ;failed return from init^hlfnc2 32 ; 33 ;** branch to new HL7 logic when the HL7 version surpasses 2.3 ** 34 ;I HL("VER")]2.3 D EN^RAHLRPT1(RADFN,RADTI,RACNI,RAEID),EXIT Q 35 ;** branch to new HL7 logic when the HL7 version surpasses 2.3 ** 36 ; 37 S DFN=RADFN D DEM^VADPT 38 I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT 39 S RAN=0 40 S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3)) ; NOTE: Check 41 ; for an inexact date of birth. If inexact, pass null for DOB in 42 ; the 'PID' segment. Some COTS systems can't handle inexact DOB's. 43 D SETUP,PID,OBR,OBXPRC,OBXIMP,OBXDIA,OBXRPT,OBXMOD,OBXTCM 44 EXIT ; set HL7 message type & return to RA RPT protocol 45 S HL("MTN")="ORU" 46 N HLEID,HLARYTYP,HLFORMAT,HLMTIEN,HLP 47 S HLEID=RAEID,HLARYTYP="LM",HLFORMAT=1,HLMTIEN="",HLP("PRIORITY")="I" 48 M:$D(RASSS) HLP=RASSS 49 D:$D(RASSSX(HLEID)) GETHLP^RAHLRS1(HLEID,.HLP) 50 D GENERATE^HLMA(HLEID,HLARYTYP,HLFORMAT,.HLRESLT,HLMTIEN,.HLP) 51 K RAVADM 52 Q 53 ; 54 OBR ;Compile 'OBR' Segment 55 S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$P(RACPTNDE,U,2)_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP" 56 ; Replace above with following when Imaging can cope with ESC chars 57 ; S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$$ESCAPE^RAHLRU($P(RACPTNDE,U,2))_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$$ESCAPE^RAHLRU($P(RAPRCNDE,U))_$E(HLECH)_"99RAP" 58 ; Have to use LOCAL code if Broad Procedure - no CPT code 59 I $P(RAOBR4,$E(HLECH))=""!($P(RAOBR4,$E(HLECH),2)="") S $P(RAOBR4,$E(HLECH),1,3)=$P(RAOBR4,$E(HLECH),4,5)_$E(HLECH)_"LOCAL" 60 S X1="OBR"_HLFS_HLFS_HLFS_RADTI_"-"_RACNI_$E(HLECH)_RADTECN_$E(HLECH)_"L"_HLFS_RAOBR4_HLFS_HLFS_HLFS_RADTE0_HLFS_HLQ_HLFS_HLQ_HLFS_HLFS_HLFS_HLFS_HLFS,Y=$$HLDATE^HLFNC($P(RARPT0,"^",6)) S X1=X1_Y_HLFS_HLFS 61 S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01) 62 S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"") 63 S $P(X1,HLFS,19)=$S($D(^DIC(42,+$P(RACN0,"^",6),0)):$P(^(0),"^"),$D(^SC(+$P(RACN0,"^",8),0)):$P(^(0),"^"),1:"Unknown") 64 ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name 65 N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0)) 66 S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0)) 67 S $P(X1,HLFS,21)=$P(RACN00,"^",4)_$E(HLECH)_$P($G(^SC(RA20,0)),"^")_$E(HLECH)_$P(RACN00,"^",3)_$E(HLECH)_$P($G(^DIC(4,$P(RACN00,U,3),0)),"^") 68 S $P(X1,HLFS,21)=$P(X1,HLFS,21) 69 ; Replace above with following when Imaging can cope with ESC chars 70 ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21)) 71 ; 72 S OBR36=9999999.9999-RADTI 73 S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36) 74 ; 75 S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7)) 76 S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R") 77 ;Principal Result Interpreter = Verifying Physician 78 S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D 79 .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']"" 80 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 81 .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y 82 ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident 83 S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D 84 .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']"" 85 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 86 .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y 87 I $P(RACN0,"^",12) D 88 .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']"" 89 .S Y=$$HLNAME^HLFNC(X2) Q:Y']"" 90 .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y 91 ;Technician = Technologist 92 S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D 93 .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q 94 .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q 95 .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']"" 96 .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q 97 .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y 98 ;Transcriptionist 99 S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D 100 .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q 101 .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q 102 .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y 103 ; 104 ; if long str, break so 2nd str begins with separator to avoid abend 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)="") 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" 107 S RAN=RAN+1 108 I $D(RAPART) S HLA("HLS",RAN)=$P(RAPART(1),HLFS)_HLFS,HLA("HLS",RAN,1)=$P(RAPART(1),HLFS,2,99)_HLFS,HLA("HLS",RAN,2)=RAPART(2) K RAPART Q 109 S HLA("HLS",RAN)=X1 110 Q 111 OBXDIA ;Compile 'OBX' Segment for Diagnostic Code 112 S RAI=$P($G(^RA(78.3,+$P(RACN0,"^",13),0)),"^") I RAI]"" D 113 .S RAN=RAN+1 114 .I $$PATCH^XPDUTL("MAG*2.5*1")!(+$$VERSION^XPDUTL("MAG")>2.5) D 115 ..S HLA("HLS",RAN)="OBX"_HLFS_HLFS_"CE"_HLFS_"D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L"_HLFS_HLFS_+$P(RACN0,"^",13)_$E(HLECH)_RAI_$E(HLECH)_"L" 116 ..; Replace above with following when Imaging can cope with ESC chars 117 ..; S HLA("HLS",RAN)="OBX"_HLFS_HLFS_"CE"_HLFS_"D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L"_HLFS_HLFS_+$P(RACN0,"^",13)_$E(HLECH)_$$ESCAPE^RAHLRU(RAI)_$E(HLECH)_"L" 118 .E D 119 ..S HLA("HLS",RAN)="OBX"_HLFS_HLFS_"ST"_HLFS_"D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L"_HLFS_HLFS_RAI 120 .D OBX11^RAHLRU 121 Q:'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)) ;any secondary dx 122 S X2=0 123 OBXDIA2 S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",X2)) Q:'X2 124 S Y=+^(X2,0),X=$P($G(^RA(78.3,+Y,0)),U) 125 I X]"" D 126 .S RAN=RAN+1 127 .I $$PATCH^XPDUTL("MAG*2.5*1")!(+$$VERSION^XPDUTL("MAG")>2.5) D 128 ..S HLA("HLS",RAN)="OBX"_HLFS_HLFS_"CE"_HLFS_"D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L"_HLFS_HLFS_Y_$E(HLECH)_X_$E(HLECH)_"L" 129 ..; Replace above with following when Imaging can cope with ESC chars 130 ..; S HLA("HLS",RAN)="OBX"_HLFS_HLFS_"CE"_HLFS_"D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L"_HLFS_HLFS_Y_$E(HLECH)_$$ESCAPE^RAHLRU(X)_$E(HLECH)_"L" 131 .E D 132 ..S HLA("HLS",RAN)="OBX"_HLFS_HLFS_"ST"_HLFS_"D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L"_HLFS_HLFS_X 133 .D OBX11^RAHLRU 134 G OBXDIA2 135 ; 136 OBXIMP ;Compile 'OBX' segment for Impression 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 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 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 140 Q 141 OBXMOD ;Compile 'OBX' Segment for Modifiers 142 S RAN=RAN+1 D OBXMOD^RAHLRU 143 Q 144 OBXPRC ;Compile 'OBX' Segment for Procedure 145 S RAN=RAN+1 D OBXPRC^RAHLRU 146 Q 147 OBXTCM ; Compile 'OBX' Segment for Tech Comments 148 D OBXTCM^RAHLRU 149 Q 150 OBXRPT ;Compile 'OBX' Segment for Radiology Report Text 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 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 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 154 ; Replace above with following when Imaging can cope with ESC chars 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 156 Q 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.
