- 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 Feb 19, 2025@00:03:08 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)