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

RAMAG04.m

Go to the documentation of this file.
  1. RAMAG04 ;HCIOFO/SG - ORDERS/EXAMS API (ORDER CANCEL/HOLD) ; 1/25/08 1:17pm
  1. ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
  1. ;
  1. Q
  1. ;
  1. ;##### CANCELS/HOLDS THE ORDER
  1. ;
  1. ; .RAPARAMS Reference to the API descriptor
  1. ; (see the ^RA01 routine for details)
  1. ;
  1. ; RAOIFN IEN of the order in the file #75.1
  1. ;
  1. ; RAREASON Cancel/Hold reason: 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. ;
  1. ; The referenced record must have appropriate type
  1. ; (see TYPE OF REASON field (2) of the file #75.2):
  1. ;
  1. ; * If the reason record has the CANCEL REQUEST (1)
  1. ; type, then the RAMISC("HOLDESC") is ignored and
  1. ; the order is canceled.
  1. ;
  1. ; * If the reason record is of the HOLD REQUEST (3)
  1. ; type, then the order is put on hold. If the
  1. ; RAMISC("HOLDESC") is defined, the text is stored
  1. ; into the HOLD DESCRIPTION field.
  1. ;
  1. ; * If the record is of the GENERAL REQUEST type (9),
  1. ; then the new order status is determined by the
  1. ; RAMISC("HOLDESC"). If it is defined, then the
  1. ; order is put on hold; otherwise, the order is
  1. ; canceled.
  1. ;
  1. ; [.RAMISC] Reference to a local array containing miscellaneous
  1. ; parameters.
  1. ; RAMISC(
  1. ;
  1. ; "HOLDESC", Text for the HOLD DESCRIPTION field (25)
  1. ; Seq#) of the file #75.1.
  1. ; Required: No
  1. ; Default: undefined
  1. ;
  1. ; NOTE: If there are active cases in the RAD/NUC MED PATIENT
  1. ; file (#70) associated with an order, this function does
  1. ; not cancel/hold the order and returns the error code -42.
  1. ;
  1. ; Return values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Success
  1. ;
  1. ORDCANC(RAPARAMS,RAOIFN,RAREASON,RAMISC) ;
  1. N ACTION,PNODE,RALOCK,RARC,RSNIEN,STATUS,TMP
  1. D:$G(RAPARAMS("DEBUG"))>1
  1. . D W^RAMAGU11("$$ORDCANC^RAMAG04","!!")
  1. . D VARS^RAMAGU11("RAOIFN,RAREASON")
  1. . D ZW^RAUTL22("RAMISC")
  1. ;
  1. ;--- Validate parameters
  1. S RARC=$$CHKREQ^RAUTL22("RAOIFN,RAREASON") Q:RARC<0 RARC
  1. S RAOIFN=+RAOIFN
  1. ;
  1. ;--- Determine whether to hold or cancel
  1. S RSNIEN=$$RARSNIEN^RAMAGU13(RAREASON,.TMP) Q:RSNIEN<0 RSNIEN
  1. S TMP=+TMP ; Internal value of the TYPE OF REASON field
  1. S ACTION=$S(TMP=1:1,TMP=3:3,$D(RAMISC("HOLDESC"))>1:3,1:1)
  1. ;
  1. ;--- Lock the order record
  1. K TMP S TMP(75.1,RAOIFN_",")=""
  1. S RARC=$$LOCKFM^RALOCK(.TMP)
  1. Q:RARC $$LOCKERR^RAERR(RARC,"order")
  1. M RALOCK=TMP
  1. ;
  1. D
  1. . N $ESTACK,$ETRAP
  1. . ;--- Setup the error processing
  1. . D SETDEFEH^RAERR("RARC")
  1. . ;
  1. . ;--- Check the current status
  1. . S STATUS=$$ORDSTAT^RAMAGU02(RAOIFN)
  1. . I STATUS<0 S RARC=STATUS Q
  1. . Q:+STATUS=1 ; Already canceled
  1. . ;
  1. . ;--- Check if all related examinations in file #70 are canceled
  1. . I $D(^RADPT("AO",RAOIFN))>1 S RARC=0 D Q:RARC<0
  1. . . N FOUND,RAFLT,RAFLTL,RANODE
  1. . . S RANODE=$NA(^RADPT("AO",RAOIFN))
  1. . . S RAFLTL=$L(RANODE)-1,RAFLT=$E(RANODE,1,RAFLTL)
  1. . . S FOUND=0
  1. . . F S RANODE=$Q(@RANODE) Q:$E(RANODE,1,RAFLTL)'=RAFLT D Q:FOUND
  1. . . . S TMP=$QS(RANODE,3)_U_$QS(RANODE,4)_U_$QS(RANODE,5)
  1. . . . S TMP=$$EXMSTAT^RAMAGU05(TMP) S:$P(TMP,U,3) FOUND=1
  1. . . S:FOUND RARC=$$ERROR^RAERR(-42)
  1. . ;
  1. . ;--- Update status
  1. . S RARC=$$UPDORDST^RAMAGU02(RAOIFN,ACTION,RSNIEN) Q:RARC'>0
  1. . ;
  1. . ;--- Populate the HOLD DESCRIPTION field
  1. . I ACTION=3,$D(RAMISC("HOLDESC"))>1 S RARC=0 D Q:RARC<0
  1. . . N IENS,RAFDA,RAMSG
  1. . . S RAFDA(75.1,RAOIFN_",",25)=$NA(RAMISC("HOLDESC"))
  1. . . D FILE^DIE(,"RAFDA","RAMSG")
  1. . . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,75.1,RAOIFN_",")
  1. ;
  1. ;--- Error handling and cleanup
  1. D UNLOCKFM^RALOCK(.RALOCK)
  1. Q $S(RARC<0:RARC,1:0)