Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAHLRPT

RAHLRPT.m

Go to the documentation of this file. 
  1. RAHLRPT ;HISC/CAH AISC/SAW-Compiles HL7 'ORU' Message Type ; 4/26/01 10:40am
  1.  ;;5.0;Radiology/Nuclear Medicine;**2,12,10,25,81,80,84**;Mar 16, 1998;Build 13
  1. EN ; Called from RA RPT and RA RPT 2.3 protocol entry action
  1.  ; Input variables:
  1.  ;   RADFN=file 2 IEN (DFN)
  1.  ;   RADTI=file 70 Exam subrecord IEN (reverse date/time)
  1.  ;   RACNI=file 70 Case subrecord IEN
  1.  ;   RARPT=file 74 Report IEN
  1.  ;   RASSS=List of Subscribers passed into GENERATE^HLMA  will be set into HLP array.
  1.  ; Output variables:
  1.  ;   HLA("HLS", array containing HL7 msg
  1.  ;   RATELREL = 1  Indicates that the text: 'Released for local dictation by National Teleradiology'
  1.  ;              has been included in Impression or Report section
  1.  ;   RATELX =   Text used as indication of Release for local dictation... if not set use defauld above...
  1.  ;   RATELE =   1 If RANOSEND is Teleradiology type vendor
  1.  ;
  1.  ;Integration Agreements
  1.  ;----------------------
  1.  ;$$GET1^DIQ(2056); ^DIWP(10011); $$HLDATE/$$HLNAME^HLFNC(10106)
  1.  ;GENERATE^HLMA(2164); DEM^VADPT(10061); $$FMTHL7^XLFDT(10103)
  1.  ;$$PATCH^XPDUTL(10141); $$VERSION^XPDUTL(10141)
  1.  ;
  1.  N RASET,RACN0,RATELE,RATELREL,RATELX
  1.  D INIT^RAHLRPTT ;Patch 84
  1.  I +$P(RACN0,U,25)=2 D  Q  ; printset
  1.  .; loop through all cases in set and create message
  1.  .S RASET=1
  1.  .N RACNI,RAII S RAII=0
  1.  .F  S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0  D
  1.  .. Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2
  1.  .. S RACNI=RAII
  1.  .. D NEW
  1. NEW ; new variables
  1.  S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global
  1.  N DFN,DIWF,DIWL,DIWR,RACPT,RACPTNDE,RADTECN,RADTE0,RADTV,RAI,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RARPT0
  1.  N VADM,VAERR,X,X1,X2,XX2,Y,X0,OBR36,EID,HL,INT,HLQ,HLFS,HLECH,HLA,RAN K RAVADM
  1.  D INIT^RAHLRU ;initialize HL7 variables
  1.  Q:+$G(HL)=15  ;no known client(item) linked to the event driver protocol
  1.  Q:$O(HL(""))=""  ;failed return from INIT^HLFNC2 (called by INIT^RAHLRU)
  1.  ;
  1.  ;** branch to new HL7 logic when the HL7 version surpasses 2.3 **
  1.  I HL("VER")>2.3,($T(^RAHLRPT1))'="" D EN^RAHLRPT1(RADFN,RADTI,RACNI,RAEID),EXIT Q
  1.  ;** branch to new HL7 logic when the HL7 version surpasses 2.3 **
  1.  ;
  1.  S DFN=RADFN D DEM^VADPT
  1.  I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT
  1.  S RAN=0
  1.  S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3)) ; NOTE: Check
  1.  ; for an inexact date of birth.  If inexact, pass null for DOB in
  1.  ; the 'PID' segment.  Some COTS systems can't handle inexact DOB's.
  1.  D SETUP^RAHLRPTT,PID^RAHLRPTT,OBR,OBXPRC,OBXIMP,OBXDIA,OBXRPT,OBXMOD,OBXTCM
  1. EXIT ; set HL7 message type & return to RA RPT protocol
  1.  ;For P84 see if this is a >>Released for local reading<< type report and if yes resend the ORM (^RAHLRS1)...
  1.  I $G(RATELREL) D RESEND^RAHLRPTT(RADFN,RADTI,RACNI) Q  ;P84 resend in the case that report released from Telerad
  1.  S HL("MTN")="ORU"
  1.  N HLEID,HLARYTYP,HLFORMAT,HLMTIEN,HLP
  1.  S HLEID=RAEID,HLARYTYP="LM",HLFORMAT=1,HLMTIEN="",HLP("PRIORITY")="I"
  1.  M:$D(RASSS) HLP=RASSS
  1.  D:$D(RASSSX(HLEID)) GETHLP^RAHLRS1(HLEID,.HLP,"RASSSX")
  1.  D GENERATE^HLMA(HLEID,HLARYTYP,HLFORMAT,.HLRESLT,HLMTIEN,.HLP)
  1.  K RAVADM
  1.  Q
  1.  ;
  1. OBR ;Compile 'OBR' Segment
  1.  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"
  1.  ; Replace above with following when Imaging can cope with ESC chars
  1.  ; 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"
  1.  ; Have to use LOCAL code if Broad Procedure - no CPT code
  1.  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"
  1.  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
  1.  S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01)
  1.  S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"")
  1.  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")
  1.  ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name
  1.  N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0))
  1.  S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0))
  1.  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)),"^")
  1.  S $P(X1,HLFS,21)=$P(X1,HLFS,21)
  1.  ; Replace above with following when Imaging can cope with ESC chars
  1.  ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21))
  1.  ;
  1.  S OBR36=9999999.9999-RADTI
  1.  S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36)
  1.  ;
  1.  S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7))
  1.  S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R")
  1.  ;Principal Result Interpreter = Verifying Physician
  1.  S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D
  1.  .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']""
  1.  .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
  1.  .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y
  1.  ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident
  1.  S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D
  1.  .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']""
  1.  .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
  1.  .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y
  1.  I $P(RACN0,"^",12) D
  1.  .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']""
  1.  .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
  1.  .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y
  1.  ;Technician = Technologist
  1.  S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D
  1.  .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q
  1.  .S X2=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)),"^",1) I X2']"" Q
  1.  .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']""
  1.  .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q
  1.  .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y
  1.  ;Transcriptionist
  1.  S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D
  1.  .S X2=$$GET1^DIQ(200,$P(^RARPT(RARPT,"T"),"^",1),.01) I X2']"" Q
  1.  .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q
  1.  .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y
  1.  ;
  1.  ; if long str, break so 2nd str begins with separator to avoid abend
  1.  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)="")
  1.  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"
  1.  S RAN=RAN+1
  1.  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
  1.  S HLA("HLS",RAN)=X1
  1.  Q
  1. OBXDIA ;Compile 'OBX' Segment for Diagnostic Code
  1.  S RAI=$P($G(^RA(78.3,+$P(RACN0,"^",13),0)),"^") I RAI]"" D
  1.  .S RAN=RAN+1
  1.  .I $$PATCH^XPDUTL("MAG*2.5*1")!(+$$VERSION^XPDUTL("MAG")>2.5) D
  1.  ..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"
  1.  ..; Replace above with following when Imaging can cope with ESC chars
  1.  ..; 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"
  1.  .E  D
  1.  ..S HLA("HLS",RAN)="OBX"_HLFS_HLFS_"ST"_HLFS_"D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L"_HLFS_HLFS_RAI
  1.  .D OBX11^RAHLRU
  1.  Q:'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))  ;any secondary dx
  1.  S X2=0
  1. OBXDIA2 S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",X2)) Q:'X2
  1.  S Y=+^(X2,0),X=$P($G(^RA(78.3,+Y,0)),U)
  1.  I X]"" D
  1.  .S RAN=RAN+1
  1.  .I $$PATCH^XPDUTL("MAG*2.5*1")!(+$$VERSION^XPDUTL("MAG")>2.5) D
  1.  ..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"
  1.  ..; Replace above with following when Imaging can cope with ESC chars
  1.  ..; 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"
  1.  .E  D
  1.  ..S HLA("HLS",RAN)="OBX"_HLFS_HLFS_"ST"_HLFS_"D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L"_HLFS_HLFS_X
  1.  .D OBX11^RAHLRU
  1.  G OBXDIA2
  1.  ;
  1. OBXIMP ;Compile 'OBX' segment for Impression
  1.  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
  1.  K ^UTILITY($J,"W") S DIWF="",DIWR=80,DIWL=1
  1.  F RAI=0:0 S RAI=$O(^RARPT(RARPT,"I",RAI)) Q:'RAI  I $D(^(RAI,0)) S X=^(0) D RATELREL,^DIWP
  1.  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
  1.  Q
  1. OBXMOD ;Compile 'OBX' Segment for Modifiers
  1.  S RAN=RAN+1 D OBXMOD^RAHLRU
  1.  Q
  1. OBXPRC ;Compile 'OBX' Segment for Procedure
  1.  S RAN=RAN+1 D OBXPRC^RAHLRU
  1.  Q
  1. OBXTCM ;Compile 'OBX' Segment for Tech Comments
  1.  D OBXTCM^RAHLRU
  1.  Q
  1. OBXRPT ;Compile 'OBX' Segment for Radiology Report Text
  1.  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
  1.  K ^UTILITY($J,"W") S DIWF="",DIWR=80,DIWL=1
  1.  F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI  I $D(^(RAI,0)) S X=^(0) D RATELREL,^DIWP
  1.  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
  1.  ; Replace above with following when Imaging can cope with ESC chars
  1.  ; 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
  1.  Q
  1. RATELREL ;Release the study for local reading
  1.  I $G(RATELE),X[$G(RATELX) S RATELREL=1 Q
  1.  ;