RAMAG06A ;HCIOFO/SG - ORDERS/EXAMS API (EXAM EDIT TOOLS) ; 2/6/09 11:14am
;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
;
Q
;
;+++++ EXAM EDIT PRE-PROCESSING
;
; RACTION Actions (can be combined):
; E Examined (procedure has been performed)
; C Complete
;
; .RATRKCMB Reference to a local variable where current values
; of the CONTRAST MEDIA multiple will be saved.
;
; .RAPRIEN Reference to a local array where some of current
; case properties will be saved.
;
; Input variables:
; RACNI, RADFN, RADTI
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Ok
;
; NOTE: This is an internal entry point. Do not call it from outside
; of exam editing routines.
;
EDTPRE(RACTION,RATRKCMB,RAPRIEN) ;
N RARC
S RARC=0
;--- Save 'before' CONTRAST MEDIA data values to compare
;--- against the possible 'after' values
D TRK70CMB^RAMAINU(RADFN,RADTI,RACNI,.RATRKCMB)
;--- Save 'before' values (in RAPRIEN) to compare later in RAUTL1
D SVBEFOR^RAO7XX(RADFN,RADTI,RACNI)
;---
Q $S(RARC<0:RARC,1:0)
;
;+++++ EXAM EDIT POST-PROCESSING
;
; RACTION Actions (can be combined):
; E Examined (procedure has been performed)
; C Complete
;
; RATRKCMB Old values from the CONTRAST MEDIA multiple
;
; .RAPRIEN Reference to a local array with saved case
; properties.
;
; Input variables:
; RACASE, RACNI, RADFN, RADTI, RAMISC
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Ok
;
; NOTE: This is an internal entry point. Do not call it from outside
; of exam editing routines.
;
EDTPST(RACTION,RATRKCMB,RAPRIEN) ;
N FLAGS,N,RABLNK,RACAT,RAD3,RADELFLG,RAEXM0,RAEXOR,RAIENS,RAILP,RAMIFN,RAMOD,RAMODA,RAMODD,RAOIFN,RAOPT,RAORD0,RAORDB4,RAOREA,RAOSTS,RAPRC,RARC,RARSH,RASFM,RASHA,RATRKCMA,TMP,X,ZTQUEUED
;--- Compare new values with those saved by the SVBEFOR^RAO7XX and
;--- send changed order control "XX" to CPRS but do not send alert.
S TMP=$$CMPAFTR^RAO7XX(0)
;--- Send HL7 messages
S FLAGS=$$TRFLAGS^RAUTL22($G(RAMISC("FLAGS")),"S","S")
I RACTION["E" D Q:RARC<0 RARC
. S RARC=$$EXAMINED^RAMAGHL(RACASE,FLAGS)
I RACTION["C" D Q:RARC<0 RARC
. S RARC=$$REPORT^RAMAGHL(RACASE,FLAGS)
;--- Update the request/order status
D
. N IORI,IOSTBM ; Otherwise, the code breaks the BROWSER device
. N ZTQUEUED
. S ZTQUEUED=1 ; Suppress the output
. D ^RAORDC
;--- Compare 'before' and 'after' CONTRAST MEDIA data
;--- and update the audit log if necessary.
D TRK70CMA^RAMAINU(RADFN,RADTI,RACNI,RATRKCMB)
;---
Q $S(RARC<0:RARC,1:0)
;
;+++++ NUCLEAR MEDICINE CODE
;
; RACASE Examination identifiers
; ^01: IEN of the patient in the file #70 (RADFN)
; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
; ^03: IEN in the EXAMINATIONS multiple (RACNI)
;
; RACTION Actions (can be combined):
; E Examined (procedure has been performed)
; C Complete
;
; .RAMISC Reference to a local array containing miscellaneous
; request parameters.
;
; .RAFDA Reference to a local array where field values will
; be prepared for storage (FileMan FDA array).
;
; Input variables:
; RACN, RADTE, RAMISC, RAMSPSDEFS, RAPROCIEN
;
; Output variables:
; RALOCK, RAMISC
;
; Return Values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Nuclear medicine data is not needed
; >0 IEN of the record of the NUC MED EXAM DATA file (#70.2)
;
NUCMED(RACASE,RACTION,RAMISC,RAFDA) ;
N RANMDIEN,RARC,TMP
;--- Create the nuclear medicine stub if necessary
S RANMDIEN=$$NMEDSTUB^RAMAGU13(RACASE,RAPROCIEN,RADTE,RACN)
Q:RANMDIEN<0 RANMDIEN
;--- Nuclear medicine related
I RANMDIEN>0 D Q:RARC<0 RARC
. ;--- Lock the nuclear medicine data
. K TMP S TMP(70.2,RANMDIEN_",")=""
. S RARC=$$LOCKFM^RALOCK(.TMP)
. I RARC S RARC=$$LOCKERR^RAERR(RARC,"nuc. med. data") Q
. M RALOCK=TMP
. ;--- Validate parameters
. S RARC=$$VAL702^RAMAGU14(RANMDIEN_",",RACTION,.RAMISC,.RAFDA)
. I RARC<0 S RARC=$$ERROR^RAERR(-11) Q
;--- Success
Q RANMDIEN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAG06A 4418 printed Sep 23, 2025@20:12:59 Page 2
RAMAG06A ;HCIOFO/SG - ORDERS/EXAMS API (EXAM EDIT TOOLS) ; 2/6/09 11:14am
+1 ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
+2 ;
+3 QUIT
+4 ;
+5 ;+++++ EXAM EDIT PRE-PROCESSING
+6 ;
+7 ; RACTION Actions (can be combined):
+8 ; E Examined (procedure has been performed)
+9 ; C Complete
+10 ;
+11 ; .RATRKCMB Reference to a local variable where current values
+12 ; of the CONTRAST MEDIA multiple will be saved.
+13 ;
+14 ; .RAPRIEN Reference to a local array where some of current
+15 ; case properties will be saved.
+16 ;
+17 ; Input variables:
+18 ; RACNI, RADFN, RADTI
+19 ;
+20 ; Return values:
+21 ; <0 Error descriptor (see $$ERROR^RAERR)
+22 ; 0 Ok
+23 ;
+24 ; NOTE: This is an internal entry point. Do not call it from outside
+25 ; of exam editing routines.
+26 ;
EDTPRE(RACTION,RATRKCMB,RAPRIEN) ;
+1 NEW RARC
+2 SET RARC=0
+3 ;--- Save 'before' CONTRAST MEDIA data values to compare
+4 ;--- against the possible 'after' values
+5 DO TRK70CMB^RAMAINU(RADFN,RADTI,RACNI,.RATRKCMB)
+6 ;--- Save 'before' values (in RAPRIEN) to compare later in RAUTL1
+7 DO SVBEFOR^RAO7XX(RADFN,RADTI,RACNI)
+8 ;---
+9 QUIT $SELECT(RARC<0:RARC,1:0)
+10 ;
+11 ;+++++ EXAM EDIT POST-PROCESSING
+12 ;
+13 ; RACTION Actions (can be combined):
+14 ; E Examined (procedure has been performed)
+15 ; C Complete
+16 ;
+17 ; RATRKCMB Old values from the CONTRAST MEDIA multiple
+18 ;
+19 ; .RAPRIEN Reference to a local array with saved case
+20 ; properties.
+21 ;
+22 ; Input variables:
+23 ; RACASE, RACNI, RADFN, RADTI, RAMISC
+24 ;
+25 ; Return values:
+26 ; <0 Error descriptor (see $$ERROR^RAERR)
+27 ; 0 Ok
+28 ;
+29 ; NOTE: This is an internal entry point. Do not call it from outside
+30 ; of exam editing routines.
+31 ;
EDTPST(RACTION,RATRKCMB,RAPRIEN) ;
+1 NEW FLAGS,N,RABLNK,RACAT,RAD3,RADELFLG,RAEXM0,RAEXOR,RAIENS,RAILP,RAMIFN,RAMOD,RAMODA,RAMODD,RAOIFN,RAOPT,RAORD0,RAORDB4,RAOREA,RAOSTS,RAPRC,RARC,RARSH,RASFM,RASHA,RATRKCMA,TMP,X,ZTQUEUED
+2 ;--- Compare new values with those saved by the SVBEFOR^RAO7XX and
+3 ;--- send changed order control "XX" to CPRS but do not send alert.
+4 SET TMP=$$CMPAFTR^RAO7XX(0)
+5 ;--- Send HL7 messages
+6 SET FLAGS=$$TRFLAGS^RAUTL22($GET(RAMISC("FLAGS")),"S","S")
+7 IF RACTION["E"
Begin DoDot:1
+8 SET RARC=$$EXAMINED^RAMAGHL(RACASE,FLAGS)
End DoDot:1
if RARC<0
QUIT RARC
+9 IF RACTION["C"
Begin DoDot:1
+10 SET RARC=$$REPORT^RAMAGHL(RACASE,FLAGS)
End DoDot:1
if RARC<0
QUIT RARC
+11 ;--- Update the request/order status
+12 Begin DoDot:1
+13 ; Otherwise, the code breaks the BROWSER device
NEW IORI,IOSTBM
+14 NEW ZTQUEUED
+15 ; Suppress the output
SET ZTQUEUED=1
+16 DO ^RAORDC
End DoDot:1
+17 ;--- Compare 'before' and 'after' CONTRAST MEDIA data
+18 ;--- and update the audit log if necessary.
+19 DO TRK70CMA^RAMAINU(RADFN,RADTI,RACNI,RATRKCMB)
+20 ;---
+21 QUIT $SELECT(RARC<0:RARC,1:0)
+22 ;
+23 ;+++++ NUCLEAR MEDICINE CODE
+24 ;
+25 ; RACASE Examination identifiers
+26 ; ^01: IEN of the patient in the file #70 (RADFN)
+27 ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
+28 ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
+29 ;
+30 ; RACTION Actions (can be combined):
+31 ; E Examined (procedure has been performed)
+32 ; C Complete
+33 ;
+34 ; .RAMISC Reference to a local array containing miscellaneous
+35 ; request parameters.
+36 ;
+37 ; .RAFDA Reference to a local array where field values will
+38 ; be prepared for storage (FileMan FDA array).
+39 ;
+40 ; Input variables:
+41 ; RACN, RADTE, RAMISC, RAMSPSDEFS, RAPROCIEN
+42 ;
+43 ; Output variables:
+44 ; RALOCK, RAMISC
+45 ;
+46 ; Return Values:
+47 ; <0 Error descriptor (see $$ERROR^RAERR)
+48 ; 0 Nuclear medicine data is not needed
+49 ; >0 IEN of the record of the NUC MED EXAM DATA file (#70.2)
+50 ;
NUCMED(RACASE,RACTION,RAMISC,RAFDA) ;
+1 NEW RANMDIEN,RARC,TMP
+2 ;--- Create the nuclear medicine stub if necessary
+3 SET RANMDIEN=$$NMEDSTUB^RAMAGU13(RACASE,RAPROCIEN,RADTE,RACN)
+4 if RANMDIEN<0
QUIT RANMDIEN
+5 ;--- Nuclear medicine related
+6 IF RANMDIEN>0
Begin DoDot:1
+7 ;--- Lock the nuclear medicine data
+8 KILL TMP
SET TMP(70.2,RANMDIEN_",")=""
+9 SET RARC=$$LOCKFM^RALOCK(.TMP)
+10 IF RARC
SET RARC=$$LOCKERR^RAERR(RARC,"nuc. med. data")
QUIT
+11 MERGE RALOCK=TMP
+12 ;--- Validate parameters
+13 SET RARC=$$VAL702^RAMAGU14(RANMDIEN_",",RACTION,.RAMISC,.RAFDA)
+14 IF RARC<0
SET RARC=$$ERROR^RAERR(-11)
QUIT
End DoDot:1
if RARC<0
QUIT RARC
+15 ;--- Success
+16 QUIT RANMDIEN
