Index: FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLRPT.m
===================================================================
--- FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLRPT.m	(revision 631)
+++ FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLRPT.m	(revision 636)
@@ -1,4 +1,4 @@
 RAHLRPT ;HISC/CAH AISC/SAW-Compiles HL7 'ORU' Message Type ; 4/26/01 10:40am
- ;;5.0;Radiology/Nuclear Medicine;**2,12,10,25,81,80,84**;Mar 16, 1998;Build 13
+ ;;5.0;Radiology/Nuclear Medicine;**2,12,10,25,81,80**;Mar 16, 1998;Build 19
 EN ; Called from RA RPT and RA RPT 2.3 protocol entry action
  ; Input variables:
@@ -10,17 +10,9 @@
  ; Output variables:
  ;   HLA("HLS", array containing HL7 msg
- ;   RATELREL = 1  Indicates that the text: 'Released for local dictation by National Teleradiology'
- ;              has been included in Impression or Report section
- ;   RATELX =   Text used as indication of Release for local dictation... if not set use defauld above...
- ;   RATELE =   1 If RANOSEND is Teleradiology type vendor
  ;
- ;Integration Agreements
- ;----------------------
- ;$$GET1^DIQ(2056); ^DIWP(10011); $$HLDATE/$$HLNAME^HLFNC(10106)
- ;GENERATE^HLMA(2164); DEM^VADPT(10061); $$FMTHL7^XLFDT(10103)
- ;$$PATCH^XPDUTL(10141); $$VERSION^XPDUTL(10141)
- ;
- N RASET,RACN0,RATELE,RATELREL,RATELX
- D INIT^RAHLRPTT ;Patch 84
+ N RASET,RACN0
+ S RASET=0
+ S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
+ S:'$D(RARPT) RARPT=+$P(RACN0,"^",17)
  I +$P(RACN0,U,25)=2 D  Q  ; printset
  .; loop through all cases in set and create message
@@ -37,8 +29,8 @@
  D INIT^RAHLRU ;initialize HL7 variables
  Q:+$G(HL)=15  ;no known client(item) linked to the event driver protocol
- Q:$O(HL(""))=""  ;failed return from INIT^HLFNC2 (called by INIT^RAHLRU)
+ Q:$O(HL(""))=""  ;failed return from init^hlfnc2
  ;
  ;** branch to new HL7 logic when the HL7 version surpasses 2.3 **
- I HL("VER")>2.3,($T(^RAHLRPT1))'="" D EN^RAHLRPT1(RADFN,RADTI,RACNI,RAEID),EXIT Q
+ ;I HL("VER")]2.3 D EN^RAHLRPT1(RADFN,RADTI,RACNI,RAEID),EXIT Q
  ;** branch to new HL7 logic when the HL7 version surpasses 2.3 **
  ;
@@ -49,13 +41,11 @@
  ; for an inexact date of birth.  If inexact, pass null for DOB in
  ; the 'PID' segment.  Some COTS systems can't handle inexact DOB's.
- D SETUP^RAHLRPTT,PID^RAHLRPTT,OBR,OBXPRC,OBXIMP,OBXDIA,OBXRPT,OBXMOD,OBXTCM
+ D SETUP,PID,OBR,OBXPRC,OBXIMP,OBXDIA,OBXRPT,OBXMOD,OBXTCM
 EXIT ; set HL7 message type & return to RA RPT protocol
- ;For P84 see if this is a >>Released for local reading<< type report and if yes resend the ORM (^RAHLRS1)...
- I $G(RATELREL) D RESEND^RAHLRPTT(RADFN,RADTI,RACNI) Q  ;P84 resend in the case that report released from Telerad
  S HL("MTN")="ORU"
  N HLEID,HLARYTYP,HLFORMAT,HLMTIEN,HLP
  S HLEID=RAEID,HLARYTYP="LM",HLFORMAT=1,HLMTIEN="",HLP("PRIORITY")="I"
  M:$D(RASSS) HLP=RASSS
- D:$D(RASSSX(HLEID)) GETHLP^RAHLRS1(HLEID,.HLP,"RASSSX")
+ D:$D(RASSSX(HLEID)) GETHLP^RAHLRS1(HLEID,.HLP)
  D GENERATE^HLMA(HLEID,HLARYTYP,HLFORMAT,.HLRESLT,HLMTIEN,.HLP)
  K RAVADM
@@ -102,5 +92,5 @@
  S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D
  .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q
- .S X2=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)),"^",1) I X2']"" Q
+ .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q
  .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']""
  .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q
@@ -108,10 +98,10 @@
  ;Transcriptionist
  S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D
- .S X2=$$GET1^DIQ(200,$P(^RARPT(RARPT,"T"),"^",1),.01) I X2']"" Q
+ .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q
  .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q
  .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y
  ;
  ; if long str, break so 2nd str begins with separator to avoid abend
- 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)="")
+ 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)="")
  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"
  S RAN=RAN+1
@@ -146,6 +136,5 @@
 OBXIMP ;Compile 'OBX' segment for Impression
  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
- 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 RATELREL,^DIWP
+ 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
  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
  Q
@@ -156,16 +145,26 @@
  S RAN=RAN+1 D OBXPRC^RAHLRU
  Q
-OBXTCM ;Compile 'OBX' Segment for Tech Comments
+OBXTCM ; Compile 'OBX' Segment for Tech Comments
  D OBXTCM^RAHLRU
  Q
 OBXRPT ;Compile 'OBX' Segment for Radiology Report Text
  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
- 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 RATELREL,^DIWP
+ 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
  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
  ; Replace above with following when Imaging can cope with ESC chars
  ; 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
  Q
-RATELREL ;Release the study for local reading
- I $G(RATELE),X[$G(RATELX) S RATELREL=1 Q
- ; 
+PID ;Compile 'PID' Segment
+ I HL("VER")']"2.2" D
+ .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
+ .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
+ I HL("VER")]"2.2" S RAN=RAN+1,HLA("HLS",RAN)=$$EN^VAFHLPID(DFN,"2,3,5,7,8,19,20")
+ Q
+SETUP ; Setup basic examination information
+ S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
+ S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,0)
+ S RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1)
+ S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9)
+ S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)
+ S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN)
+ Q
