RAMAG05 ;HCIOFO/SG - ORDERS/EXAMS API (EXAM CANCEL) ; 2/1/08 10:01am
;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
;
Q
;
;##### CANCELS THE EXAM(S)
;
; .RAPARAMS Reference to the API descriptor
; (see the ^RA01 routine for details)
;
; RACASE Exam/case 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)
;
; RAREASON Reason for cancelation: either IEN of a record of
; the RAD/NUC MED REASON file (#75.2) or a valid
; synonym (see SYNONYM field (3) of the file #75.2).
; The referenced record must have 'CANCEL REQUEST'
; or 'GENERAL REQUEST' type (see TYPE OF REASON
; field (2) of the file #75.2).
;
; [RAFLAGS] Flags that control execution (can be combined):
;
; A Cancel all related exams/cases (those that
; reference the same order).
;
; O Cancel/hold the related order after successful
; exam(s) cancelation.
;
; The order will be canceled or put on hold only
; if there are no more active cases associated
; with it.
;
; Otherwise, error code -42 will be returned.
; Use the "A" flag to cancel all related exams
; and guarantee the order cancelation.
;
; [.RAMISC] Reference to a local array containing miscellaneous
; parameters.
;
; See the ^RAMAG routine for additional important
; details regarding this parameter.
;
; RAMISC(
;
; "HOLDESC", Text for the HOLD DESCRIPTION field (25) of the
; Seq#) order associated with the exam (in file #75.1).
; Required: No
; Default: undefined
;
; "ORDRSN") Cancel/Hold reason for the order associated
; with the exam(s): 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).
; Required: No
; Default: Value of the RAREASON parameter
;
; If the RAFLAGS parameter contains the "O" flag, the "ORDRSN" and
; "HOLDESC" parameters determine whether the related order is
; canceled or put on hold. Otherwise, they are ignored.
;
; * If the reason record referenced by the "ORDRSN" node has the
; CANCEL REQUEST (1) type, then the "HOLDESC" node is ignored and
; the order is canceled.
;
; * If the record referenced by the "ORDRSN" node is of the HOLD
; REQUEST (3) type, then the order is put on hold. If the "HOLDESC"
; node is defined, the text is stored into the HOLD DESCRIPTION
; field.
;
; * If the record referenced by the "ORDRSN" node is of the GENERAL
; REQUEST type (9), then the action performed on the order is
; determined by the "HOLDESC" node. If it is defined, then the
; order is put on hold; otherwise, the order is canceled.
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR).
; 0 Exam has been canceled
;
EXAMCANC(RAPARAMS,RACASE,RAREASON,RAFLAGS,RAMISC) ;
N CASE,EXAMLST,LOCKTMP,RACNI,RADFN,RADTI,RALOCK,RAMSG,RAOIFN,RARC,RSNIEN,STATUS,TMP
D:$G(RAPARAMS("DEBUG"))>1
. D W^RAMAGU11("$$EXAMCANC^RAMAG05","!!")
. D VARS^RAMAGU11("RACASE,RAREASON,RAFLAGS")
. D ZW^RAUTL22("RAMISC")
;
;=== Validate parameters
S RARC=$$CHKREQ^RAUTL22("RACASE,RAREASON") Q:RARC<0 RARC
S RACASE=$P(RACASE,U,1,3),RAFLAGS=$G(RAFLAGS)
S RARC=$$CHKEXMID^RAMAGU04(RACASE) Q:RARC<0 RARC
S RADFN=$P(RACASE,U)
;
;=== Find the IEN of the synonym
S RSNIEN=$$RARSNIEN^RAMAGU13(RAREASON) Q:RSNIEN<0 RSNIEN
;
;=== Get IEN of the order (only if necessary)
I $TR(RAFLAGS,"AO")'=RAFLAGS S RARC=0 D Q:RARC<0 RARC
. S TMP=$$EXAMIENS^RAMAGU04(RACASE)
. S RAOIFN=+$$GET1^DIQ(70.03,TMP,11,"I",,"RAMSG")
. I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9,70.03,TMP) Q
. S LOCKTMP(75.1,RAOIFN_",")=""
;
;=== Prepare the list of exams
S EXAMLST(RACASE)=""
S LOCKTMP(70.03,$$EXAMIENS^RAMAGU04(RACASE))=""
I RAFLAGS["A" D
. N RAFLT,RAFLTL,RANODE
. S RANODE=$NA(^RADPT("AO",RAOIFN))
. S RAFLTL=$L(RANODE)-1,RAFLT=$E(RANODE,1,RAFLTL)
. F S RANODE=$Q(@RANODE) Q:$E(RANODE,1,RAFLTL)'=RAFLT D
. . S CASE=$QS(RANODE,3)_U_$QS(RANODE,4)_U_$QS(RANODE,5)
. . S EXAMLST(CASE)=""
. . S LOCKTMP(70.03,$$EXAMIENS^RAMAGU04(CASE))=""
;
;=== Lock affected objects
S RARC=$$LOCKFM^RALOCK(.LOCKTMP)
Q:RARC $$LOCKERR^RAERR(RARC,"examination(s)")
M RALOCK=LOCKTMP
;
D
. N $ESTACK,$ETRAP,BUF
. ;=== Setup the error processing
. D SETDEFEH^RAERR("RARC")
. ;
. ;=== Cancel the exam(s)
. S CASE=""
. F S CASE=$O(EXAMLST(CASE)) Q:CASE="" D Q:RARC<0
. . S STATUS=$$EXMSTAT^RAMAGU05(CASE)
. . I STATUS<0 S RARC=STATUS Q
. . S RADTI=$P(CASE,U,2),RACNI=$P(CASE,U,3)
. . S EXAMLST(CASE)=STATUS
. . ;--- Check if the case has already been canceled
. . I '$P(STATUS,U,3) K EXAMLST(CASE) Q
. . ;--- Check the ALLOW CANCELLING? field
. . S TMP=$$GET1^DIQ(72,+STATUS,6,"I",,"RAMSG")
. . Q:$$UP^XLFSTR(TMP)'="Y"
. . ;--- Update exam status
. . S RARC=$$UPDEXMST^RAMAGU05(CASE,"^^0",,RSNIEN) Q:RARC<0
. . K EXAMLST(CASE)
. . ;--- Send notifications
. . D CANCEL^RAHLRPC
. Q:RARC<0
. ;
. ;=== Check if all exams have been canceled
. I $D(EXAMLST)>1 D Q
. . N I K RAMSG
. . F I=1:1 S CASE=$O(EXAMLST(CASE)) Q:CASE="" D
. . . S TMP="Exam IENS='"_$$EXAMIENS^RAMAGU04(CASE)_"'"
. . . S RAMSG(I)=TMP_", Status='"_$P(EXAMLST(CASE),U,2)_"'"
. . S RARC=$$ERROR^RAERR(-51,.RAMSG)
. ;
. ;=== Cancel the order
. I RAFLAGS["O" D Q:RARC<0
. . S TMP=$G(RAMISC("ORDRSN"))
. . I TMP'?." " D I RSNIEN<0 S RARC=RSNIEN Q
. . . S RSNIEN=$$RARSNIEN^RAMAGU13(TMP)
. . S RARC=$$ORDCANC^RAMAG04(.RAPARAMS,RAOIFN,RSNIEN,.RAMISC)
;
;=== Error handling and cleanup
D UNLOCKFM^RALOCK(.RALOCK)
Q $S(RARC<0:RARC,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAG05 6331 printed Nov 22, 2024@17:46:50 Page 2
RAMAG05 ;HCIOFO/SG - ORDERS/EXAMS API (EXAM CANCEL) ; 2/1/08 10:01am
+1 ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
+2 ;
+3 QUIT
+4 ;
+5 ;##### CANCELS THE EXAM(S)
+6 ;
+7 ; .RAPARAMS Reference to the API descriptor
+8 ; (see the ^RA01 routine for details)
+9 ;
+10 ; RACASE Exam/case identifiers:
+11 ; ^01: IEN of the patient in the file #70 (RADFN)
+12 ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
+13 ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
+14 ;
+15 ; RAREASON Reason for cancelation: either IEN of a record of
+16 ; the RAD/NUC MED REASON file (#75.2) or a valid
+17 ; synonym (see SYNONYM field (3) of the file #75.2).
+18 ; The referenced record must have 'CANCEL REQUEST'
+19 ; or 'GENERAL REQUEST' type (see TYPE OF REASON
+20 ; field (2) of the file #75.2).
+21 ;
+22 ; [RAFLAGS] Flags that control execution (can be combined):
+23 ;
+24 ; A Cancel all related exams/cases (those that
+25 ; reference the same order).
+26 ;
+27 ; O Cancel/hold the related order after successful
+28 ; exam(s) cancelation.
+29 ;
+30 ; The order will be canceled or put on hold only
+31 ; if there are no more active cases associated
+32 ; with it.
+33 ;
+34 ; Otherwise, error code -42 will be returned.
+35 ; Use the "A" flag to cancel all related exams
+36 ; and guarantee the order cancelation.
+37 ;
+38 ; [.RAMISC] Reference to a local array containing miscellaneous
+39 ; parameters.
+40 ;
+41 ; See the ^RAMAG routine for additional important
+42 ; details regarding this parameter.
+43 ;
+44 ; RAMISC(
+45 ;
+46 ; "HOLDESC", Text for the HOLD DESCRIPTION field (25) of the
+47 ; Seq#) order associated with the exam (in file #75.1).
+48 ; Required: No
+49 ; Default: undefined
+50 ;
+51 ; "ORDRSN") Cancel/Hold reason for the order associated
+52 ; with the exam(s): either IEN of a record of
+53 ; the RAD/NUC MED REASON file (#75.2) or a valid
+54 ; synonym (see SYNONYM field (3) of that file).
+55 ; Required: No
+56 ; Default: Value of the RAREASON parameter
+57 ;
+58 ; If the RAFLAGS parameter contains the "O" flag, the "ORDRSN" and
+59 ; "HOLDESC" parameters determine whether the related order is
+60 ; canceled or put on hold. Otherwise, they are ignored.
+61 ;
+62 ; * If the reason record referenced by the "ORDRSN" node has the
+63 ; CANCEL REQUEST (1) type, then the "HOLDESC" node is ignored and
+64 ; the order is canceled.
+65 ;
+66 ; * If the record referenced by the "ORDRSN" node is of the HOLD
+67 ; REQUEST (3) type, then the order is put on hold. If the "HOLDESC"
+68 ; node is defined, the text is stored into the HOLD DESCRIPTION
+69 ; field.
+70 ;
+71 ; * If the record referenced by the "ORDRSN" node is of the GENERAL
+72 ; REQUEST type (9), then the action performed on the order is
+73 ; determined by the "HOLDESC" node. If it is defined, then the
+74 ; order is put on hold; otherwise, the order is canceled.
+75 ;
+76 ; Return values:
+77 ; <0 Error descriptor (see $$ERROR^RAERR).
+78 ; 0 Exam has been canceled
+79 ;
EXAMCANC(RAPARAMS,RACASE,RAREASON,RAFLAGS,RAMISC) ;
+1 NEW CASE,EXAMLST,LOCKTMP,RACNI,RADFN,RADTI,RALOCK,RAMSG,RAOIFN,RARC,RSNIEN,STATUS,TMP
+2 if $GET(RAPARAMS("DEBUG"))>1
Begin DoDot:1
+3 DO W^RAMAGU11("$$EXAMCANC^RAMAG05","!!")
+4 DO VARS^RAMAGU11("RACASE,RAREASON,RAFLAGS")
+5 DO ZW^RAUTL22("RAMISC")
End DoDot:1
+6 ;
+7 ;=== Validate parameters
+8 SET RARC=$$CHKREQ^RAUTL22("RACASE,RAREASON")
if RARC<0
QUIT RARC
+9 SET RACASE=$PIECE(RACASE,U,1,3)
SET RAFLAGS=$GET(RAFLAGS)
+10 SET RARC=$$CHKEXMID^RAMAGU04(RACASE)
if RARC<0
QUIT RARC
+11 SET RADFN=$PIECE(RACASE,U)
+12 ;
+13 ;=== Find the IEN of the synonym
+14 SET RSNIEN=$$RARSNIEN^RAMAGU13(RAREASON)
if RSNIEN<0
QUIT RSNIEN
+15 ;
+16 ;=== Get IEN of the order (only if necessary)
+17 IF $TRANSLATE(RAFLAGS,"AO")'=RAFLAGS
SET RARC=0
Begin DoDot:1
+18 SET TMP=$$EXAMIENS^RAMAGU04(RACASE)
+19 SET RAOIFN=+$$GET1^DIQ(70.03,TMP,11,"I",,"RAMSG")
+20 IF $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,70.03,TMP)
QUIT
+21 SET LOCKTMP(75.1,RAOIFN_",")=""
End DoDot:1
if RARC<0
QUIT RARC
+22 ;
+23 ;=== Prepare the list of exams
+24 SET EXAMLST(RACASE)=""
+25 SET LOCKTMP(70.03,$$EXAMIENS^RAMAGU04(RACASE))=""
+26 IF RAFLAGS["A"
Begin DoDot:1
+27 NEW RAFLT,RAFLTL,RANODE
+28 SET RANODE=$NAME(^RADPT("AO",RAOIFN))
+29 SET RAFLTL=$LENGTH(RANODE)-1
SET RAFLT=$EXTRACT(RANODE,1,RAFLTL)
+30 FOR
SET RANODE=$QUERY(@RANODE)
if $EXTRACT(RANODE,1,RAFLTL)'=RAFLT
QUIT
Begin DoDot:2
+31 SET CASE=$QSUBSCRIPT(RANODE,3)_U_$QSUBSCRIPT(RANODE,4)_U_$QSUBSCRIPT(RANODE,5)
+32 SET EXAMLST(CASE)=""
+33 SET LOCKTMP(70.03,$$EXAMIENS^RAMAGU04(CASE))=""
End DoDot:2
End DoDot:1
+34 ;
+35 ;=== Lock affected objects
+36 SET RARC=$$LOCKFM^RALOCK(.LOCKTMP)
+37 if RARC
QUIT $$LOCKERR^RAERR(RARC,"examination(s)")
+38 MERGE RALOCK=LOCKTMP
+39 ;
+40 Begin DoDot:1
+41 NEW $ESTACK,$ETRAP,BUF
+42 ;=== Setup the error processing
+43 DO SETDEFEH^RAERR("RARC")
+44 ;
+45 ;=== Cancel the exam(s)
+46 SET CASE=""
+47 FOR
SET CASE=$ORDER(EXAMLST(CASE))
if CASE=""
QUIT
Begin DoDot:2
+48 SET STATUS=$$EXMSTAT^RAMAGU05(CASE)
+49 IF STATUS<0
SET RARC=STATUS
QUIT
+50 SET RADTI=$PIECE(CASE,U,2)
SET RACNI=$PIECE(CASE,U,3)
+51 SET EXAMLST(CASE)=STATUS
+52 ;--- Check if the case has already been canceled
+53 IF '$PIECE(STATUS,U,3)
KILL EXAMLST(CASE)
QUIT
+54 ;--- Check the ALLOW CANCELLING? field
+55 SET TMP=$$GET1^DIQ(72,+STATUS,6,"I",,"RAMSG")
+56 if $$UP^XLFSTR(TMP)'="Y"
QUIT
+57 ;--- Update exam status
+58 SET RARC=$$UPDEXMST^RAMAGU05(CASE,"^^0",,RSNIEN)
if RARC<0
QUIT
+59 KILL EXAMLST(CASE)
+60 ;--- Send notifications
+61 DO CANCEL^RAHLRPC
End DoDot:2
if RARC<0
QUIT
+62 if RARC<0
QUIT
+63 ;
+64 ;=== Check if all exams have been canceled
+65 IF $DATA(EXAMLST)>1
Begin DoDot:2
+66 NEW I
KILL RAMSG
+67 FOR I=1:1
SET CASE=$ORDER(EXAMLST(CASE))
if CASE=""
QUIT
Begin DoDot:3
+68 SET TMP="Exam IENS='"_$$EXAMIENS^RAMAGU04(CASE)_"'"
+69 SET RAMSG(I)=TMP_", Status='"_$PIECE(EXAMLST(CASE),U,2)_"'"
End DoDot:3
+70 SET RARC=$$ERROR^RAERR(-51,.RAMSG)
End DoDot:2
QUIT
+71 ;
+72 ;=== Cancel the order
+73 IF RAFLAGS["O"
Begin DoDot:2
+74 SET TMP=$GET(RAMISC("ORDRSN"))
+75 IF TMP'?." "
Begin DoDot:3
+76 SET RSNIEN=$$RARSNIEN^RAMAGU13(TMP)
End DoDot:3
IF RSNIEN<0
SET RARC=RSNIEN
QUIT
+77 SET RARC=$$ORDCANC^RAMAG04(.RAPARAMS,RAOIFN,RSNIEN,.RAMISC)
End DoDot:2
if RARC<0
QUIT
End DoDot:1
+78 ;
+79 ;=== Error handling and cleanup
+80 DO UNLOCKFM^RALOCK(.RALOCK)
+81 QUIT $SELECT(RARC<0:RARC,1:0)
