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