RAMAG04 ;HCIOFO/SG - ORDERS/EXAMS API (ORDER CANCEL/HOLD) ; 1/25/08 1:17pm
;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
;
Q
;
;##### CANCELS/HOLDS THE ORDER
;
; .RAPARAMS Reference to the API descriptor
; (see the ^RA01 routine for details)
;
; RAOIFN IEN of the order in the file #75.1
;
; RAREASON Cancel/Hold 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).
;
; The referenced record must have appropriate type
; (see TYPE OF REASON field (2) of the file #75.2):
;
; * If the reason record has the CANCEL REQUEST (1)
; type, then the RAMISC("HOLDESC") is ignored and
; the order is canceled.
;
; * If the reason record is of the HOLD REQUEST (3)
; type, then the order is put on hold. If the
; RAMISC("HOLDESC") is defined, the text is stored
; into the HOLD DESCRIPTION field.
;
; * If the record is of the GENERAL REQUEST type (9),
; then the new order status is determined by the
; RAMISC("HOLDESC"). If it is defined, then the
; order is put on hold; otherwise, the order is
; canceled.
;
; [.RAMISC] Reference to a local array containing miscellaneous
; parameters.
; RAMISC(
;
; "HOLDESC", Text for the HOLD DESCRIPTION field (25)
; Seq#) of the file #75.1.
; Required: No
; Default: undefined
;
; NOTE: If there are active cases in the RAD/NUC MED PATIENT
; file (#70) associated with an order, this function does
; not cancel/hold the order and returns the error code -42.
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Success
;
ORDCANC(RAPARAMS,RAOIFN,RAREASON,RAMISC) ;
N ACTION,PNODE,RALOCK,RARC,RSNIEN,STATUS,TMP
D:$G(RAPARAMS("DEBUG"))>1
. D W^RAMAGU11("$$ORDCANC^RAMAG04","!!")
. D VARS^RAMAGU11("RAOIFN,RAREASON")
. D ZW^RAUTL22("RAMISC")
;
;--- Validate parameters
S RARC=$$CHKREQ^RAUTL22("RAOIFN,RAREASON") Q:RARC<0 RARC
S RAOIFN=+RAOIFN
;
;--- Determine whether to hold or cancel
S RSNIEN=$$RARSNIEN^RAMAGU13(RAREASON,.TMP) Q:RSNIEN<0 RSNIEN
S TMP=+TMP ; Internal value of the TYPE OF REASON field
S ACTION=$S(TMP=1:1,TMP=3:3,$D(RAMISC("HOLDESC"))>1:3,1:1)
;
;--- Lock the order record
K TMP S TMP(75.1,RAOIFN_",")=""
S RARC=$$LOCKFM^RALOCK(.TMP)
Q:RARC $$LOCKERR^RAERR(RARC,"order")
M RALOCK=TMP
;
D
. N $ESTACK,$ETRAP
. ;--- Setup the error processing
. D SETDEFEH^RAERR("RARC")
. ;
. ;--- Check the current status
. S STATUS=$$ORDSTAT^RAMAGU02(RAOIFN)
. I STATUS<0 S RARC=STATUS Q
. Q:+STATUS=1 ; Already canceled
. ;
. ;--- Check if all related examinations in file #70 are canceled
. I $D(^RADPT("AO",RAOIFN))>1 S RARC=0 D Q:RARC<0
. . N FOUND,RAFLT,RAFLTL,RANODE
. . S RANODE=$NA(^RADPT("AO",RAOIFN))
. . S RAFLTL=$L(RANODE)-1,RAFLT=$E(RANODE,1,RAFLTL)
. . S FOUND=0
. . F S RANODE=$Q(@RANODE) Q:$E(RANODE,1,RAFLTL)'=RAFLT D Q:FOUND
. . . S TMP=$QS(RANODE,3)_U_$QS(RANODE,4)_U_$QS(RANODE,5)
. . . S TMP=$$EXMSTAT^RAMAGU05(TMP) S:$P(TMP,U,3) FOUND=1
. . S:FOUND RARC=$$ERROR^RAERR(-42)
. ;
. ;--- Update status
. S RARC=$$UPDORDST^RAMAGU02(RAOIFN,ACTION,RSNIEN) Q:RARC'>0
. ;
. ;--- Populate the HOLD DESCRIPTION field
. I ACTION=3,$D(RAMISC("HOLDESC"))>1 S RARC=0 D Q:RARC<0
. . N IENS,RAFDA,RAMSG
. . S RAFDA(75.1,RAOIFN_",",25)=$NA(RAMISC("HOLDESC"))
. . D FILE^DIE(,"RAFDA","RAMSG")
. . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,75.1,RAOIFN_",")
;
;--- Error handling and cleanup
D UNLOCKFM^RALOCK(.RALOCK)
Q $S(RARC<0:RARC,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAG04 4015 printed Dec 13, 2024@02:36:51 Page 2
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
+2 ;
+3 QUIT
+4 ;
+5 ;##### CANCELS/HOLDS THE ORDER
+6 ;
+7 ; .RAPARAMS Reference to the API descriptor
+8 ; (see the ^RA01 routine for details)
+9 ;
+10 ; RAOIFN IEN of the order in the file #75.1
+11 ;
+12 ; RAREASON Cancel/Hold reason: either IEN of a record of
+13 ; the RAD/NUC MED REASON file (#75.2) or a valid
+14 ; synonym (see SYNONYM field (3) of that file).
+15 ;
+16 ; The referenced record must have appropriate type
+17 ; (see TYPE OF REASON field (2) of the file #75.2):
+18 ;
+19 ; * If the reason record has the CANCEL REQUEST (1)
+20 ; type, then the RAMISC("HOLDESC") is ignored and
+21 ; the order is canceled.
+22 ;
+23 ; * If the reason record is of the HOLD REQUEST (3)
+24 ; type, then the order is put on hold. If the
+25 ; RAMISC("HOLDESC") is defined, the text is stored
+26 ; into the HOLD DESCRIPTION field.
+27 ;
+28 ; * If the record is of the GENERAL REQUEST type (9),
+29 ; then the new order status is determined by the
+30 ; RAMISC("HOLDESC"). If it is defined, then the
+31 ; order is put on hold; otherwise, the order is
+32 ; canceled.
+33 ;
+34 ; [.RAMISC] Reference to a local array containing miscellaneous
+35 ; parameters.
+36 ; RAMISC(
+37 ;
+38 ; "HOLDESC", Text for the HOLD DESCRIPTION field (25)
+39 ; Seq#) of the file #75.1.
+40 ; Required: No
+41 ; Default: undefined
+42 ;
+43 ; NOTE: If there are active cases in the RAD/NUC MED PATIENT
+44 ; file (#70) associated with an order, this function does
+45 ; not cancel/hold the order and returns the error code -42.
+46 ;
+47 ; Return values:
+48 ; <0 Error descriptor (see $$ERROR^RAERR)
+49 ; 0 Success
+50 ;
ORDCANC(RAPARAMS,RAOIFN,RAREASON,RAMISC) ;
+1 NEW ACTION,PNODE,RALOCK,RARC,RSNIEN,STATUS,TMP
+2 if $GET(RAPARAMS("DEBUG"))>1
Begin DoDot:1
+3 DO W^RAMAGU11("$$ORDCANC^RAMAG04","!!")
+4 DO VARS^RAMAGU11("RAOIFN,RAREASON")
+5 DO ZW^RAUTL22("RAMISC")
End DoDot:1
+6 ;
+7 ;--- Validate parameters
+8 SET RARC=$$CHKREQ^RAUTL22("RAOIFN,RAREASON")
if RARC<0
QUIT RARC
+9 SET RAOIFN=+RAOIFN
+10 ;
+11 ;--- Determine whether to hold or cancel
+12 SET RSNIEN=$$RARSNIEN^RAMAGU13(RAREASON,.TMP)
if RSNIEN<0
QUIT RSNIEN
+13 ; Internal value of the TYPE OF REASON field
SET TMP=+TMP
+14 SET ACTION=$SELECT(TMP=1:1,TMP=3:3,$DATA(RAMISC("HOLDESC"))>1:3,1:1)
+15 ;
+16 ;--- Lock the order record
+17 KILL TMP
SET TMP(75.1,RAOIFN_",")=""
+18 SET RARC=$$LOCKFM^RALOCK(.TMP)
+19 if RARC
QUIT $$LOCKERR^RAERR(RARC,"order")
+20 MERGE RALOCK=TMP
+21 ;
+22 Begin DoDot:1
+23 NEW $ESTACK,$ETRAP
+24 ;--- Setup the error processing
+25 DO SETDEFEH^RAERR("RARC")
+26 ;
+27 ;--- Check the current status
+28 SET STATUS=$$ORDSTAT^RAMAGU02(RAOIFN)
+29 IF STATUS<0
SET RARC=STATUS
QUIT
+30 ; Already canceled
if +STATUS=1
QUIT
+31 ;
+32 ;--- Check if all related examinations in file #70 are canceled
+33 IF $DATA(^RADPT("AO",RAOIFN))>1
SET RARC=0
Begin DoDot:2
+34 NEW FOUND,RAFLT,RAFLTL,RANODE
+35 SET RANODE=$NAME(^RADPT("AO",RAOIFN))
+36 SET RAFLTL=$LENGTH(RANODE)-1
SET RAFLT=$EXTRACT(RANODE,1,RAFLTL)
+37 SET FOUND=0
+38 FOR
SET RANODE=$QUERY(@RANODE)
if $EXTRACT(RANODE,1,RAFLTL)'=RAFLT
QUIT
Begin DoDot:3
+39 SET TMP=$QSUBSCRIPT(RANODE,3)_U_$QSUBSCRIPT(RANODE,4)_U_$QSUBSCRIPT(RANODE,5)
+40 SET TMP=$$EXMSTAT^RAMAGU05(TMP)
if $PIECE(TMP,U,3)
SET FOUND=1
End DoDot:3
if FOUND
QUIT
+41 if FOUND
SET RARC=$$ERROR^RAERR(-42)
End DoDot:2
if RARC<0
QUIT
+42 ;
+43 ;--- Update status
+44 SET RARC=$$UPDORDST^RAMAGU02(RAOIFN,ACTION,RSNIEN)
if RARC'>0
QUIT
+45 ;
+46 ;--- Populate the HOLD DESCRIPTION field
+47 IF ACTION=3
IF $DATA(RAMISC("HOLDESC"))>1
SET RARC=0
Begin DoDot:2
+48 NEW IENS,RAFDA,RAMSG
+49 SET RAFDA(75.1,RAOIFN_",",25)=$NAME(RAMISC("HOLDESC"))
+50 DO FILE^DIE(,"RAFDA","RAMSG")
+51 if $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,75.1,RAOIFN_",")
End DoDot:2
if RARC<0
QUIT
End DoDot:1
+52 ;
+53 ;--- Error handling and cleanup
+54 DO UNLOCKFM^RALOCK(.RALOCK)
+55 QUIT $SELECT(RARC<0:RARC,1:0)
