RAMAGU05 ;HCIOFO/SG - ORDERS/EXAMS API (EXAM UTILITIES) ; 5/27/08 2:16pm
;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
;
Q
;
;##### RETURNS EXAM STATUS
;
; 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)
;
; Return Values:
; <0 Error descriptor (see $$ERROR^RAERR)
; >0 Exam status descriptor (see the ^RAMAGU06)
;
EXMSTAT(RACASE) ;
N IEN72,IENS,RABUF,RAMSG,RC
S RC=$$CHKEXMID^RAMAGU04(RACASE) Q:RC<0 RC
;--- Get the IEN of the status record
S IENS=$$EXAMIENS^RAMAGU04(RACASE)
S IEN72=$$GET1^DIQ(70.03,IENS,3,"I",,"RAMSG")
Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.03,IENS)
Q:IEN72'>0 $$ERROR^RAERR(-19,,70.03,IENS,3)
;--- Return the descriptor
Q $$EXMSTINF^RAMAGU06(IEN72)
;
;***** UPDATES THE EXAM ACTIVITY LOG
;
; 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)
;
; ACTION Internal action value (see the TYPE OF ACTION
; field (2) of the sub-file #70.07).
;
; [COMMENT] Optional value for the TECHNOLOGIST COMMENT
; field (4) of the sub-file #70.7.
;
; [LOGDT] Internal date value (FileMan) for the LOG DATE
; field (.01) of the sub-file #70.07. If this
; parameter is not defined or not greater than 0,
; then the current date/time is used.
;
; Return Values:
; <0 Error descriptor (see $$ERROR^RAERR)
; >0 IEN of the new activity sub-record in sub-file #70.07
;
UPDEXMAL(RACASE,ACTION,COMMENT,LOGDT) ;
N IENS,IENS7003,LOGDT1,RAFDA,RAIENS,RALOCK,RAMSG,RARC,TMP
S RARC=$$CHKREQ^RAUTL22("RACASE,ACTION") Q:RARC<0 RARC
S RARC=$$CHKEXMID^RAMAGU04(RACASE) Q:RARC<0 RARC
S IENS7003=$$EXAMIENS^RAMAGU04(RACASE)
;
;--- Check the date/time
I $G(LOGDT)>0 D Q:RARC<0 RARC
. S TMP=+$E(LOGDT,1,12),LOGDT1=$$FMTE^XLFDT(TMP)
. S:(LOGDT1=TMP)!(LOGDT1="") RARC=$$IPVE^RAERR("LOGDT")
E S LOGDT1="NOW"
;
;--- Prepare the data
S IENS="+1,"_IENS7003
S RAFDA(70.07,IENS,.01)=LOGDT1 ; LOG DATE
S RAFDA(70.07,IENS,2)=ACTION ; TYPE OF ACTION
S RAFDA(70.07,IENS,3)="`"_(+DUZ) ; COMPUTER USER
S RAFDA(70.07,IENS,4)=$G(COMMENT) ; TECHNOLOGIST COMMENT
;
;--- Lock the ACTIVITY LOG multiple
K TMP S TMP(70.07,","_IENS7003)=""
S RARC=$$LOCKFM^RALOCK(.TMP)
Q:RARC $$LOCKERR^RAERR(RARC,"exam activity log")
M RALOCK=TMP
;
D
. N $ESTACK,$ETRAP
. ;--- Setup the error processing
. D SETDEFEH^RAERR("RARC")
. ;--- Add the record
. D UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
. S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,70.07,IENS)
;
;--- Error handling and cleanup
D UNLOCKFM^RALOCK(.RALOCK)
Q $S(RARC<0:RARC,1:+RAIENS(1))
;
;***** UPDATES THE EXAM STATUS
;
; 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)
;
; RASTAT Status identifier(s) in the format of the exam
; status descriptor (see the ^RAMAGU06 for details).
;
; NOTE: Imaging type required to find appropriate
; status record is extracted from the TYPE OF
; IMAGING field (2) of the sub-file #70.02.
;
; [RAFLAGS] Flags that control the execution (can be combined):
;
; F Force the new status even if not all required
; conditions (see $$EXMSTREQ^RAMAGU06) are met.
;
; [REASON] Cancellation reason: either IEN of a record of
; the RAD/NUC MED REASON file (#75.2) or a valid
; synonym (see SYNONYM field (3) of that file).
;
; This parameter is required if RASTAT=0.
;
; The referenced record must have the appropriate
; type of reason (see TYPE OF REASON field (2) of
; the file #75.2): CANCEL REQUEST (1) or GENERAL
; REQUEST (9).
;
; Return Values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Exam already has the requested status
; >0 IEN of the new record in the sub-file #70.05
;
UPDEXMST(RACASE,RASTAT,RAFLAGS,REASON) ;
N IENS,IENS7003,RAAFTER,RABEFORE,RABUF,RAFDA,RAIENS,RALOCK,RAMSG,RANODE,RARC,TMP
S RARC=$$CHKREQ^RAUTL22("RACASE,RASTAT") Q:RARC<0 RARC
S RARC=$$CHKEXMID^RAMAGU04(RACASE) Q:RARC<0 RARC
S IENS7003=$$EXAMIENS^RAMAGU04(RACASE)
S RAFLAGS=$G(RAFLAGS)
;
;=== If status order number is provided, it must be valid
S TMP=$P(RASTAT,U,3)
I TMP'="",(+TMP'=TMP)!(TMP<0)!(TMP>9) D Q RARC
. S RARC=$$IPVE^RAERR("RASTAT")
;
;=== Validate the new exam status and get its descriptor
I RASTAT'>0 D
. S IENS=$P(IENS7003,",",2,99)
. S TMP=$$GET1^DIQ(70.02,IENS,2,"I",,"RAMSG") ; TYPE OF IMAGING
. I $G(DIERR) S RASTAT=$$DBS^RAERR("RAMSG",-9,70.02,IENS) Q
. I TMP'>0 S RASTAT=$$ERROR^RAERR(-19,,70.02,IENS,2) Q
. S RASTAT=$$EXMSTINF^RAMAGU06(RASTAT,TMP)
E S RASTAT=$$EXMSTINF^RAMAGU06(RASTAT)
Q:RASTAT<0 RASTAT
;
;=== Check the cancelation reason
I $P(RASTAT,U,3)=0 D Q:RARC<0 RARC
. N RTYPE
. ;--- Check if it has a value
. I $G(REASON)="" S RARC=$$ERROR^RAERR(-8,,"REASON") Q
. ;--- Find the IEN of the synonym
. S RARC=$$RARSNIEN^RAMAGU13(REASON,.RTYPE) Q:RARC<0
. S REASON="`"_(+RARC) ; Pseudo-external value
. ;--- Check the type of reason
. S TMP=+RTYPE
. I TMP'=1,TMP'=9 D Q
. . S RARC=$$ERROR^RAERR(-16,,$P(RTYPE,U,2),$P(RASTAT,U,2))
E S REASON=""
;
;=== Lock the exam
K TMP S TMP(70.03,IENS7003)=""
S RARC=$$LOCKFM^RALOCK(.TMP)
Q:RARC $$LOCKERR^RAERR(RARC,"examination")
M RALOCK=TMP
;
D
. N $ESTACK,$ETRAP,RAOVER,ZTQUEUED
. S ZTQUEUED=1 ; Silence EXAM STATUS input transform (^RASTREQ)
. ;=== Setup the error processing
. D SETDEFEH^RAERR("RARC")
. ;
. ;=== Check if the exam currently has the same status
. S TMP=$$GET1^DIQ(70.03,IENS7003,3,"I",,"RAMSG")
. I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9,70.03,IENS7003) Q
. Q:+RASTAT=TMP
. ;
. ;=== Execute the input transform and the ^RASTREQ routine
. I RAFLAGS'["F" D Q:RARC<0
. . D VAL^DIE(70.03,IENS7003,3,,"`"_(+RASTAT),.TMP,,"RAMSG")
. . I TMP="^" S RARC=$$IPVE^RAERR("RASTAT") Q
. . Q:$G(RAAFTER)=$P(RASTAT,U,3)
. . S RARC=$$ERROR^RAERR(-31,"RACASE='"_RACASE_"'",$P(RASTAT,U,2))
. ;
. ;=== Prepare the data
. S IENS=IENS7003
. S RAFDA(70.03,IENS,3)="`"_(+RASTAT) ; EXAM STATUS
. S RAFDA(70.03,IENS,3.5)=REASON ; REASON FOR CANCELLATION
. S IENS="+1,"_IENS7003
. S RAFDA(70.05,IENS,.01)="NOW" ; STATUS CHANGE DATE/TIME
. S RAFDA(70.05,IENS,2)="`"_(+RASTAT) ; NEW STATUS
. S RAFDA(70.05,IENS,3)="`"_(+DUZ) ; COMPUTER USER
. ;
. ;=== Update the record
. D UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
. S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,70.05,IENS)
;
;=== Error handling and cleanup
D UNLOCKFM^RALOCK(.RALOCK)
Q $S(RARC<0:RARC,1:+$G(RAIENS(1)))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAGU05 7470 printed Dec 13, 2024@02:37:03 Page 2
RAMAGU05 ;HCIOFO/SG - ORDERS/EXAMS API (EXAM UTILITIES) ; 5/27/08 2:16pm
+1 ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
+2 ;
+3 QUIT
+4 ;
+5 ;##### RETURNS EXAM STATUS
+6 ;
+7 ; RACASE Examination identifiers
+8 ; ^01: IEN of the patient in the file #70 (RADFN)
+9 ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
+10 ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
+11 ;
+12 ; Return Values:
+13 ; <0 Error descriptor (see $$ERROR^RAERR)
+14 ; >0 Exam status descriptor (see the ^RAMAGU06)
+15 ;
EXMSTAT(RACASE) ;
+1 NEW IEN72,IENS,RABUF,RAMSG,RC
+2 SET RC=$$CHKEXMID^RAMAGU04(RACASE)
if RC<0
QUIT RC
+3 ;--- Get the IEN of the status record
+4 SET IENS=$$EXAMIENS^RAMAGU04(RACASE)
+5 SET IEN72=$$GET1^DIQ(70.03,IENS,3,"I",,"RAMSG")
+6 if $GET(DIERR)
QUIT $$DBS^RAERR("RAMSG",-9,70.03,IENS)
+7 if IEN72'>0
QUIT $$ERROR^RAERR(-19,,70.03,IENS,3)
+8 ;--- Return the descriptor
+9 QUIT $$EXMSTINF^RAMAGU06(IEN72)
+10 ;
+11 ;***** UPDATES THE EXAM ACTIVITY LOG
+12 ;
+13 ; RACASE Examination identifiers
+14 ; ^01: IEN of the patient in the file #70 (RADFN)
+15 ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
+16 ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
+17 ;
+18 ; ACTION Internal action value (see the TYPE OF ACTION
+19 ; field (2) of the sub-file #70.07).
+20 ;
+21 ; [COMMENT] Optional value for the TECHNOLOGIST COMMENT
+22 ; field (4) of the sub-file #70.7.
+23 ;
+24 ; [LOGDT] Internal date value (FileMan) for the LOG DATE
+25 ; field (.01) of the sub-file #70.07. If this
+26 ; parameter is not defined or not greater than 0,
+27 ; then the current date/time is used.
+28 ;
+29 ; Return Values:
+30 ; <0 Error descriptor (see $$ERROR^RAERR)
+31 ; >0 IEN of the new activity sub-record in sub-file #70.07
+32 ;
UPDEXMAL(RACASE,ACTION,COMMENT,LOGDT) ;
+1 NEW IENS,IENS7003,LOGDT1,RAFDA,RAIENS,RALOCK,RAMSG,RARC,TMP
+2 SET RARC=$$CHKREQ^RAUTL22("RACASE,ACTION")
if RARC<0
QUIT RARC
+3 SET RARC=$$CHKEXMID^RAMAGU04(RACASE)
if RARC<0
QUIT RARC
+4 SET IENS7003=$$EXAMIENS^RAMAGU04(RACASE)
+5 ;
+6 ;--- Check the date/time
+7 IF $GET(LOGDT)>0
Begin DoDot:1
+8 SET TMP=+$EXTRACT(LOGDT,1,12)
SET LOGDT1=$$FMTE^XLFDT(TMP)
+9 if (LOGDT1=TMP)!(LOGDT1="")
SET RARC=$$IPVE^RAERR("LOGDT")
End DoDot:1
if RARC<0
QUIT RARC
+10 IF '$TEST
SET LOGDT1="NOW"
+11 ;
+12 ;--- Prepare the data
+13 SET IENS="+1,"_IENS7003
+14 ; LOG DATE
SET RAFDA(70.07,IENS,.01)=LOGDT1
+15 ; TYPE OF ACTION
SET RAFDA(70.07,IENS,2)=ACTION
+16 ; COMPUTER USER
SET RAFDA(70.07,IENS,3)="`"_(+DUZ)
+17 ; TECHNOLOGIST COMMENT
SET RAFDA(70.07,IENS,4)=$GET(COMMENT)
+18 ;
+19 ;--- Lock the ACTIVITY LOG multiple
+20 KILL TMP
SET TMP(70.07,","_IENS7003)=""
+21 SET RARC=$$LOCKFM^RALOCK(.TMP)
+22 if RARC
QUIT $$LOCKERR^RAERR(RARC,"exam activity log")
+23 MERGE RALOCK=TMP
+24 ;
+25 Begin DoDot:1
+26 NEW $ESTACK,$ETRAP
+27 ;--- Setup the error processing
+28 DO SETDEFEH^RAERR("RARC")
+29 ;--- Add the record
+30 DO UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
+31 if $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,70.07,IENS)
End DoDot:1
+32 ;
+33 ;--- Error handling and cleanup
+34 DO UNLOCKFM^RALOCK(.RALOCK)
+35 QUIT $SELECT(RARC<0:RARC,1:+RAIENS(1))
+36 ;
+37 ;***** UPDATES THE EXAM STATUS
+38 ;
+39 ; RACASE Examination identifiers
+40 ; ^01: IEN of the patient in the file #70 (RADFN)
+41 ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
+42 ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
+43 ;
+44 ; RASTAT Status identifier(s) in the format of the exam
+45 ; status descriptor (see the ^RAMAGU06 for details).
+46 ;
+47 ; NOTE: Imaging type required to find appropriate
+48 ; status record is extracted from the TYPE OF
+49 ; IMAGING field (2) of the sub-file #70.02.
+50 ;
+51 ; [RAFLAGS] Flags that control the execution (can be combined):
+52 ;
+53 ; F Force the new status even if not all required
+54 ; conditions (see $$EXMSTREQ^RAMAGU06) are met.
+55 ;
+56 ; [REASON] Cancellation reason: either IEN of a record of
+57 ; the RAD/NUC MED REASON file (#75.2) or a valid
+58 ; synonym (see SYNONYM field (3) of that file).
+59 ;
+60 ; This parameter is required if RASTAT=0.
+61 ;
+62 ; The referenced record must have the appropriate
+63 ; type of reason (see TYPE OF REASON field (2) of
+64 ; the file #75.2): CANCEL REQUEST (1) or GENERAL
+65 ; REQUEST (9).
+66 ;
+67 ; Return Values:
+68 ; <0 Error descriptor (see $$ERROR^RAERR)
+69 ; 0 Exam already has the requested status
+70 ; >0 IEN of the new record in the sub-file #70.05
+71 ;
UPDEXMST(RACASE,RASTAT,RAFLAGS,REASON) ;
+1 NEW IENS,IENS7003,RAAFTER,RABEFORE,RABUF,RAFDA,RAIENS,RALOCK,RAMSG,RANODE,RARC,TMP
+2 SET RARC=$$CHKREQ^RAUTL22("RACASE,RASTAT")
if RARC<0
QUIT RARC
+3 SET RARC=$$CHKEXMID^RAMAGU04(RACASE)
if RARC<0
QUIT RARC
+4 SET IENS7003=$$EXAMIENS^RAMAGU04(RACASE)
+5 SET RAFLAGS=$GET(RAFLAGS)
+6 ;
+7 ;=== If status order number is provided, it must be valid
+8 SET TMP=$PIECE(RASTAT,U,3)
+9 IF TMP'=""
IF (+TMP'=TMP)!(TMP<0)!(TMP>9)
Begin DoDot:1
+10 SET RARC=$$IPVE^RAERR("RASTAT")
End DoDot:1
QUIT RARC
+11 ;
+12 ;=== Validate the new exam status and get its descriptor
+13 IF RASTAT'>0
Begin DoDot:1
+14 SET IENS=$PIECE(IENS7003,",",2,99)
+15 ; TYPE OF IMAGING
SET TMP=$$GET1^DIQ(70.02,IENS,2,"I",,"RAMSG")
+16 IF $GET(DIERR)
SET RASTAT=$$DBS^RAERR("RAMSG",-9,70.02,IENS)
QUIT
+17 IF TMP'>0
SET RASTAT=$$ERROR^RAERR(-19,,70.02,IENS,2)
QUIT
+18 SET RASTAT=$$EXMSTINF^RAMAGU06(RASTAT,TMP)
End DoDot:1
+19 IF '$TEST
SET RASTAT=$$EXMSTINF^RAMAGU06(RASTAT)
+20 if RASTAT<0
QUIT RASTAT
+21 ;
+22 ;=== Check the cancelation reason
+23 IF $PIECE(RASTAT,U,3)=0
Begin DoDot:1
+24 NEW RTYPE
+25 ;--- Check if it has a value
+26 IF $GET(REASON)=""
SET RARC=$$ERROR^RAERR(-8,,"REASON")
QUIT
+27 ;--- Find the IEN of the synonym
+28 SET RARC=$$RARSNIEN^RAMAGU13(REASON,.RTYPE)
if RARC<0
QUIT
+29 ; Pseudo-external value
SET REASON="`"_(+RARC)
+30 ;--- Check the type of reason
+31 SET TMP=+RTYPE
+32 IF TMP'=1
IF TMP'=9
Begin DoDot:2
+33 SET RARC=$$ERROR^RAERR(-16,,$PIECE(RTYPE,U,2),$PIECE(RASTAT,U,2))
End DoDot:2
QUIT
End DoDot:1
if RARC<0
QUIT RARC
+34 IF '$TEST
SET REASON=""
+35 ;
+36 ;=== Lock the exam
+37 KILL TMP
SET TMP(70.03,IENS7003)=""
+38 SET RARC=$$LOCKFM^RALOCK(.TMP)
+39 if RARC
QUIT $$LOCKERR^RAERR(RARC,"examination")
+40 MERGE RALOCK=TMP
+41 ;
+42 Begin DoDot:1
+43 NEW $ESTACK,$ETRAP,RAOVER,ZTQUEUED
+44 ; Silence EXAM STATUS input transform (^RASTREQ)
SET ZTQUEUED=1
+45 ;=== Setup the error processing
+46 DO SETDEFEH^RAERR("RARC")
+47 ;
+48 ;=== Check if the exam currently has the same status
+49 SET TMP=$$GET1^DIQ(70.03,IENS7003,3,"I",,"RAMSG")
+50 IF $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,70.03,IENS7003)
QUIT
+51 if +RASTAT=TMP
QUIT
+52 ;
+53 ;=== Execute the input transform and the ^RASTREQ routine
+54 IF RAFLAGS'["F"
Begin DoDot:2
+55 DO VAL^DIE(70.03,IENS7003,3,,"`"_(+RASTAT),.TMP,,"RAMSG")
+56 IF TMP="^"
SET RARC=$$IPVE^RAERR("RASTAT")
QUIT
+57 if $GET(RAAFTER)=$PIECE(RASTAT,U,3)
QUIT
+58 SET RARC=$$ERROR^RAERR(-31,"RACASE='"_RACASE_"'",$PIECE(RASTAT,U,2))
End DoDot:2
if RARC<0
QUIT
+59 ;
+60 ;=== Prepare the data
+61 SET IENS=IENS7003
+62 ; EXAM STATUS
SET RAFDA(70.03,IENS,3)="`"_(+RASTAT)
+63 ; REASON FOR CANCELLATION
SET RAFDA(70.03,IENS,3.5)=REASON
+64 SET IENS="+1,"_IENS7003
+65 ; STATUS CHANGE DATE/TIME
SET RAFDA(70.05,IENS,.01)="NOW"
+66 ; NEW STATUS
SET RAFDA(70.05,IENS,2)="`"_(+RASTAT)
+67 ; COMPUTER USER
SET RAFDA(70.05,IENS,3)="`"_(+DUZ)
+68 ;
+69 ;=== Update the record
+70 DO UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
+71 if $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,70.05,IENS)
End DoDot:1
+72 ;
+73 ;=== Error handling and cleanup
+74 DO UNLOCKFM^RALOCK(.RALOCK)
+75 QUIT $SELECT(RARC<0:RARC,1:+$GET(RAIENS(1)))
