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

RAMAG05.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. Q
  1. ;
  1. ;##### CANCELS THE EXAM(S)
  1. ;
  1. ; .RAPARAMS Reference to the API descriptor
  1. ; (see the ^RA01 routine for details)
  1. ;
  1. ; RACASE Exam/case identifiers:
  1. ; ^01: IEN of the patient in the file #70 (RADFN)
  1. ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
  1. ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
  1. ;
  1. ; RAREASON Reason for cancelation: either IEN of a record of
  1. ; the RAD/NUC MED REASON file (#75.2) or a valid
  1. ; synonym (see SYNONYM field (3) of the file #75.2).
  1. ; The referenced record must have 'CANCEL REQUEST'
  1. ; or 'GENERAL REQUEST' type (see TYPE OF REASON
  1. ; field (2) of the file #75.2).
  1. ;
  1. ; [RAFLAGS] Flags that control execution (can be combined):
  1. ;
  1. ; A Cancel all related exams/cases (those that
  1. ; reference the same order).
  1. ;
  1. ; O Cancel/hold the related order after successful
  1. ; exam(s) cancelation.
  1. ;
  1. ; The order will be canceled or put on hold only
  1. ; if there are no more active cases associated
  1. ; with it.
  1. ;
  1. ; Otherwise, error code -42 will be returned.
  1. ; Use the "A" flag to cancel all related exams
  1. ; and guarantee the order cancelation.
  1. ;
  1. ; [.RAMISC] Reference to a local array containing miscellaneous
  1. ; parameters.
  1. ;
  1. ; See the ^RAMAG routine for additional important
  1. ; details regarding this parameter.
  1. ;
  1. ; RAMISC(
  1. ;
  1. ; "HOLDESC", Text for the HOLD DESCRIPTION field (25) of the
  1. ; Seq#) order associated with the exam (in file #75.1).
  1. ; Required: No
  1. ; Default: undefined
  1. ;
  1. ; "ORDRSN") Cancel/Hold reason for the order associated
  1. ; with the exam(s): either IEN of a record of
  1. ; the RAD/NUC MED REASON file (#75.2) or a valid
  1. ; synonym (see SYNONYM field (3) of that file).
  1. ; Required: No
  1. ; Default: Value of the RAREASON parameter
  1. ;
  1. ; If the RAFLAGS parameter contains the "O" flag, the "ORDRSN" and
  1. ; "HOLDESC" parameters determine whether the related order is
  1. ; canceled or put on hold. Otherwise, they are ignored.
  1. ;
  1. ; * If the reason record referenced by the "ORDRSN" node has the
  1. ; CANCEL REQUEST (1) type, then the "HOLDESC" node is ignored and
  1. ; the order is canceled.
  1. ;
  1. ; * If the record referenced by the "ORDRSN" node is of the HOLD
  1. ; REQUEST (3) type, then the order is put on hold. If the "HOLDESC"
  1. ; node is defined, the text is stored into the HOLD DESCRIPTION
  1. ; field.
  1. ;
  1. ; * If the record referenced by the "ORDRSN" node is of the GENERAL
  1. ; REQUEST type (9), then the action performed on the order is
  1. ; determined by the "HOLDESC" node. If it is defined, then the
  1. ; order is put on hold; otherwise, the order is canceled.
  1. ;
  1. ; Return values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR).
  1. ; 0 Exam has been canceled
  1. ;
  1. EXAMCANC(RAPARAMS,RACASE,RAREASON,RAFLAGS,RAMISC) ;
  1. N CASE,EXAMLST,LOCKTMP,RACNI,RADFN,RADTI,RALOCK,RAMSG,RAOIFN,RARC,RSNIEN,STATUS,TMP
  1. D:$G(RAPARAMS("DEBUG"))>1
  1. . D W^RAMAGU11("$$EXAMCANC^RAMAG05","!!")
  1. . D VARS^RAMAGU11("RACASE,RAREASON,RAFLAGS")
  1. . D ZW^RAUTL22("RAMISC")
  1. ;
  1. ;=== Validate parameters
  1. S RARC=$$CHKREQ^RAUTL22("RACASE,RAREASON") Q:RARC<0 RARC
  1. S RACASE=$P(RACASE,U,1,3),RAFLAGS=$G(RAFLAGS)
  1. S RARC=$$CHKEXMID^RAMAGU04(RACASE) Q:RARC<0 RARC
  1. S RADFN=$P(RACASE,U)
  1. ;
  1. ;=== Find the IEN of the synonym
  1. S RSNIEN=$$RARSNIEN^RAMAGU13(RAREASON) Q:RSNIEN<0 RSNIEN
  1. ;
  1. ;=== Get IEN of the order (only if necessary)
  1. I $TR(RAFLAGS,"AO")'=RAFLAGS S RARC=0 D Q:RARC<0 RARC
  1. . S TMP=$$EXAMIENS^RAMAGU04(RACASE)
  1. . S RAOIFN=+$$GET1^DIQ(70.03,TMP,11,"I",,"RAMSG")
  1. . I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9,70.03,TMP) Q
  1. . S LOCKTMP(75.1,RAOIFN_",")=""
  1. ;
  1. ;=== Prepare the list of exams
  1. S EXAMLST(RACASE)=""
  1. S LOCKTMP(70.03,$$EXAMIENS^RAMAGU04(RACASE))=""
  1. I RAFLAGS["A" D
  1. . N RAFLT,RAFLTL,RANODE
  1. . S RANODE=$NA(^RADPT("AO",RAOIFN))
  1. . S RAFLTL=$L(RANODE)-1,RAFLT=$E(RANODE,1,RAFLTL)
  1. . F S RANODE=$Q(@RANODE) Q:$E(RANODE,1,RAFLTL)'=RAFLT D
  1. . . S CASE=$QS(RANODE,3)_U_$QS(RANODE,4)_U_$QS(RANODE,5)
  1. . . S EXAMLST(CASE)=""
  1. . . S LOCKTMP(70.03,$$EXAMIENS^RAMAGU04(CASE))=""
  1. ;
  1. ;=== Lock affected objects
  1. S RARC=$$LOCKFM^RALOCK(.LOCKTMP)
  1. Q:RARC $$LOCKERR^RAERR(RARC,"examination(s)")
  1. M RALOCK=LOCKTMP
  1. ;
  1. D
  1. . N $ESTACK,$ETRAP,BUF
  1. . ;=== Setup the error processing
  1. . D SETDEFEH^RAERR("RARC")
  1. . ;
  1. . ;=== Cancel the exam(s)
  1. . S CASE=""
  1. . F S CASE=$O(EXAMLST(CASE)) Q:CASE="" D Q:RARC<0
  1. . . S STATUS=$$EXMSTAT^RAMAGU05(CASE)
  1. . . I STATUS<0 S RARC=STATUS Q
  1. . . S RADTI=$P(CASE,U,2),RACNI=$P(CASE,U,3)
  1. . . S EXAMLST(CASE)=STATUS
  1. . . ;--- Check if the case has already been canceled
  1. . . I '$P(STATUS,U,3) K EXAMLST(CASE) Q
  1. . . ;--- Check the ALLOW CANCELLING? field
  1. . . S TMP=$$GET1^DIQ(72,+STATUS,6,"I",,"RAMSG")
  1. . . Q:$$UP^XLFSTR(TMP)'="Y"
  1. . . ;--- Update exam status
  1. . . S RARC=$$UPDEXMST^RAMAGU05(CASE,"^^0",,RSNIEN) Q:RARC<0
  1. . . K EXAMLST(CASE)
  1. . . ;--- Send notifications
  1. . . D CANCEL^RAHLRPC
  1. . Q:RARC<0
  1. . ;
  1. . ;=== Check if all exams have been canceled
  1. . I $D(EXAMLST)>1 D Q
  1. . . N I K RAMSG
  1. . . F I=1:1 S CASE=$O(EXAMLST(CASE)) Q:CASE="" D
  1. . . . S TMP="Exam IENS='"_$$EXAMIENS^RAMAGU04(CASE)_"'"
  1. . . . S RAMSG(I)=TMP_", Status='"_$P(EXAMLST(CASE),U,2)_"'"
  1. . . S RARC=$$ERROR^RAERR(-51,.RAMSG)
  1. . ;
  1. . ;=== Cancel the order
  1. . I RAFLAGS["O" D Q:RARC<0
  1. . . S TMP=$G(RAMISC("ORDRSN"))
  1. . . I TMP'?." " D I RSNIEN<0 S RARC=RSNIEN Q
  1. . . . S RSNIEN=$$RARSNIEN^RAMAGU13(TMP)
  1. . . S RARC=$$ORDCANC^RAMAG04(.RAPARAMS,RAOIFN,RSNIEN,.RAMISC)
  1. ;
  1. ;=== Error handling and cleanup
  1. D UNLOCKFM^RALOCK(.RALOCK)
  1. Q $S(RARC<0:RARC,1:0)