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

RAHLR1.m

Go to the documentation of this file. 
  1. RAHLR1 ;HISC/GJC - Generate Common Order (ORM) Message ;11/10/99  10:42
  1.  ;;5.0;Radiology/Nuclear Medicine;**47**;Mar 16, 1998;Build 21
  1.  ;Generates msg whenever a case is registered or cancelled or examined
  1.  ;              registered   cancelled   examined   complete
  1.  ; Order control : NW            CA         XO         XO
  1.  ; Order status  : IP            CA         IP         CM
  1.  ;
  1.  ;Integration Agreements
  1.  ;----------------------
  1.  ;$$GET1^DIQ(10060); NPFON^MAG7UFO(5021); $$FMTHL7^XLFDT(10103)
  1.  ;$$HLNAME^XLFNAME(3065); $$NS^XUAF4(2171); $$KSP^XUPARAM(2541)
  1.  ;
  1.  ;IA: 767 global read on ^DGSL(38.1,D0,0)
  1.  ;IA: 10039 global read on ^DIC(42,D0,44)
  1.  ;IA: 10040 global read on ^SC(D0
  1.  ;
  1. EN(RADFN,RADTI,RACNI,RAEID) ;Called from RA REG*, RA EXAMINED*, & RA CANCEL*
  1.  ;event driver protocols whose HL7 version exceeds version 2.3.
  1.  ;
  1.  ; Input Variables (from RAHLR):
  1.  ;  RADFN=file 2 IEN (DFN)
  1.  ;  RADTI=file 70 Exam subrec IEN (inverse date/time of exam)
  1.  ;  RACNI=file 70 Case subrecord IEN
  1.  ;  RAEID=ien of the event driver protocol (defined in RAHLRPC)
  1.  ;  RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
  1.  ; Output variables:
  1.  ;  HLA("HLS", array containing HL7 msg
  1.  ;
  1.  N RAPID,RAPV1,RAORC,RAOBR,RAOBX,RAX,X,XX,I,I1,I2,I3,II
  1.  ;initialize Rad/Nuc Med specific variables
  1.  D:'$D(HLFS)!'$D(HL) INIT^RAHLRU
  1.  D INIT
  1.  ;RA*5*82 RAEXEDT= Override the EXM conditions if Case edited
  1.  I '$G(RAEXEDT),$G(RAEXMDUN)=1,$P(RAZXAM,U,30)'="" Q  ;last chance to stop exm'd msg if it's already been sent
  1.  ;
  1. PID ;compile the PID segment
  1.  D PID^RAHLRU1(+RADFN)
  1.  ;
  1. PV1 ;compile the PV1 segment determine if the patient is
  1.  ;an inpatient or outpatient by looking at the exam record
  1.  D PV1^RAHLRU1(+RADFN)
  1.  ;
  1. ORC ;build the 'common order segment (ORC) segment
  1.  ;RACANC is the status of the exam 'cancelled'? If ORDER (#3) field in
  1.  ;the EXAMINATION STATUS (#72) file is set to zero, the exam has been
  1.  ;cancelled. If order is set to nine, the exam is complete.
  1.  S RAXAMSTS=$P($G(^RA(72,+$P(RAZXAM,U,3),0)),U,3)
  1.  S RACANC=$S(RAXAMSTS=0:1,1:0),RACOMP=$S(RAXAMSTS=9:1,1:0)
  1.  S RAORC(2)=$S(RACANC:"CA",$G(RAEXMDUN)=1:"XO",1:"NW")
  1.  ; define ORC-2 & ORC-3 to 'site id-mmddyy-case#' ex: 141-041106-6
  1.  ; 9/2008 -- check Site Acc Number division parameter (79,.131) and only
  1.  ; use the long site specific acc num if set to YES, else use old form
  1.  S (RAORC(3),RAORC(4))=RAZDAYCS
  1.  S RAORC(6)=$S(RACANC:"CA",RACOMP:"CM",1:"IP")
  1.  ;
  1.  ;new logic in determining the value of order status (ORC-5)
  1.  ;discovered in the development and testing of p47 on 01/14/2010
  1.  ;Variables:
  1.  ;  RA101Z - defined in RAHLRPC
  1.  ;   RAOPT - array set/killed in the entry/exit actions in options:
  1.  ;- [RA HL7 MESSAGE RESEND]
  1.  ;- [RA HL7 RESEND BY DATE RANGE]
  1.  ;  these two options may impact the definition of ORC-5
  1.  I $E($O(RAOPT("")),1,6)="RESEND",($E($G(RA101Z),1,6)="RA REG") S RAORC(6)="IP"
  1.  ;Executing the RA REG* event driver(s) should send an order control (ORC-1)
  1.  ;value of 'NW' & an order status value of 'IP' when the aforementioned options
  1.  ;are exercised.
  1.  ;
  1.  ;Quantity/Timing ORC-7.4 SCHEDULED DATE (TIME optional) 75.1;23
  1.  ;Priority ORC-7.6 REQUEST URGENCY of order 75.1;6
  1.  S RAORC(8)=$$REPEAT^RAHLRU1($E(HLECH,1),3)_$$FMTHL7^XLFDT($P(RAZORD,U,23))_$$REPEAT^RAHLRU1($E(HLECH,1),2)_$S($P(RAZORD,U,6)=1:"S",$P(RAZORD,U,6)=2:"A",1:"R")
  1.  ;Parent ORC-8 MEMBER OF SET (70.03;25); PURGED DATE (70.03,40)
  1.  S RAORC(9)=$$PARENT(RAPURGE,$P(RAZXAM,U,25))
  1.  ;Note: ORC-8 & OBR-29 share the same value
  1.  ;
  1.  ;S RAORC(10)=$$FMTHL7^XLFDT($P(RAZORD,U,16)) ;transaction d/t (order)
  1.  S RAORC(10)=$$FMTHL7^XLFDT($P(RAZRXAM,U)) ;transaction d/t (exam d/t registered)
  1.  ;
  1.  ;Entered By ORC-10 (USER ENTERING REQUEST) 75.1;15
  1.  I $P(RAZORD,U,15),($$GET1^DIQ(200,$P(RAZORD,U,15),.01)'="") D
  1.  .S RAZNME("FILE")=200,RAZNME("IENS")=$P(RAZORD,U,15)
  1.  .S RAZNME("FIELD")=.01
  1.  .S RAORC(11)=$P(RAZORD,U,15)_$E(HLECH)_$$HLNAME^XLFNAME(.RAZNME,"S",$E($G(HLECH)))
  1.  .Q
  1.  ;Ordering Provider ORC-12 (REQUESTING PHYSICIAN) 75.1;14
  1.  I $P(RAZORD,U,14),($$GET1^DIQ(200,$P(RAZORD,U,14),.01)'="") D
  1.  .K RAZNME S RAZNME("FILE")=200,RAZNME("IENS")=$P(RAZORD,U,14)
  1.  .S RAZNME("FIELD")=.01
  1.  .S RAORC(13)=$P(RAZORD,U,14)_$E(HLECH)_$$HLNAME^XLFNAME(.RAZNME,"S",$E($G(HLECH)))
  1.  .Q
  1.  ;Enterer's Location ORC-13 (USER ENTERING REQUEST)
  1.  S RASERSEC=$$ESCAPE^RAHLRU($$GET1^DIQ(200,$P(RAZORD,U,15),29))
  1.  S RAORC(14)=RASERSEC ;SERVICE/SECTION
  1.  ;
  1.  ;Call Back Phone numbers of Ordering Provider ORC-14
  1.  D
  1.  .N RAX,I,M S M="",I=0
  1.  .D NPFON^MAG7UFO("RAX",$P(RAZORD,U,14))
  1.  .F  S I=$O(RAX(I)) Q:'I  S M=M_$$ESCAPE^RAHLRU($G(RAX(I,1,1)))_$E(HLECH)_$G(RAX(I,2,1))_$E(HLECH)_$G(RAX(I,3,1))_$E(HLECH,2)
  1.  .S:$L(M) RAORC(15)=$E(M,1,$L(M)-1)
  1.  ;
  1.  ;Enterer's Organization ORC-17 (USER ENTERING REQUEST)
  1.  S RASERSEC(0)=+$$GET1^DIQ(200,$P(RAZORD,U,15),29,"I") ;pointer to 49
  1.  S RASERSEC(1)=$$GET1^DIQ(49,RASERSEC(0),1) ;abbr. of service/section
  1.  S RAORC(18)=RASERSEC(1)_$E(HLECH)_RASERSEC_$E(HLECH)_"VISTA49"
  1.  ;build the ORC segment; set the HLA array
  1.  D BLSEG^RAHLRU1("ORC",.RAORC)
  1.  K RACANC,RACOMP,RASERSEC,RAXAMSTS,RAZNME,RAZPHONE
  1.  ;
  1.  D:$T(EN^RAHLR1A)]"" EN^RAHLR1A ;continue building the OBR, OBX, & ZDS segments
  1.  ;
  1.  ; Broadcast the HL7 message and cleanup the symbol table
  1.  D GENERATE^RAHLRU
  1.  Q
  1.  ;
  1. INIT ;initialize some basic package specific variables
  1.  S:'($D(U)#2) U="^"
  1.  S RAZRXAM=$G(^RADPT(RADFN,"DT",RADTI,0)) ;reg. exam zero node
  1.  S RAZXAM=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ;exam zero node
  1.  S RAPURGE=+$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PURGE"))
  1.  S RAZDTE=9999999.9999-RADTI ;FM internal date/time
  1.  ; Check if SSAN exists for the exam:
  1.  ;     Field:  [^DD(70.03,31,0)=SITE ACCESSION NUMBER^RFI^^0;31]
  1.  ; This check should NOT be dependent on the current state of the
  1.  ; SSAN Switch (ON or OFF), don't build RAZDAYCS on the fly, use the
  1.  ; data stored in the exam (legacy accession number or SSAN)
  1.  ; if SSAN          exists set RAZDAYCS=SSAN
  1.  ; if SSAN does not exist  set RAZDAYCS=legacy accession number 
  1.  I $P(RAZXAM,"^",31)="" S RAZDAYCS=$E(RAZDTE,4,7)_$E(RAZDTE,2,3)_"-"_+RAZXAM ;Legacy Accession Number:  mmddyy-case#
  1.  I $P(RAZXAM,"^",31)'="" S RAZDAYCS=$P(RAZXAM,"^",31) ;SSAN: sss-mmddyy-case#
  1.  ;
  1.  S RAZORD=$G(^RAO(75.1,+$P(RAZXAM,U,11),0)) ;rad/nuc med order zero node
  1.  S RAZORD1=$P($G(^RAO(75.1,+$P(RAZXAM,U,11),.1)),U) ;rad/nuc  reason for study
  1.  S RAZPROC=$G(^RAMIS(71,+$P(RAZXAM,U,2),0)) ;exam specific procedure
  1.  Q
  1.  ;
  1. PARENT(PRGE,PRNT) ;Define fields ORC-8 & OBR-29 known as PARENT
  1.  ; input: PRGE=purge date of the exam (if applicable)
  1.  ;        PRNT=parent/descendant if yes, specify if exam or printset
  1.  ;return: VALUE=ORIGINAL ORDER PURGED if purged, EXAMSET: proc_name
  1.  ;        if examset, PRINTSET: proc_name if printset, or null.
  1.  I PRGE,(PRGE'>DT) S VALUE="ORIGINAL ORDER PURGED"
  1.  I PRNT S VALUE=$S(PRNT=1:"Examset: ",1:"Printset: ")_$P($G(^RAMIS(71,+$P(RAZORD,U,2),0)),U)
  1.  Q $G(VALUE)
  1.  ;