RAMAGU02 ;HCIOFO/SG - ORDERS/EXAMS API (ORDER UTILITIES) ; 1/24/08 5:37pm
;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
;
Q
;
;##### RETURNS ORDER STATUS
;
; RAOIFN IEN of the exam order in the RAD/NUC MED ORDERS
; file (#75.1)
;
; Return Values:
; <0 Error descriptor (see $$ERROR^RAERR)
; ... Internal and external values of the order status
; separated by "^"
;
ORDSTAT(RAOIFN) ;
N IENS,RABUF,RAMSG
Q:$G(RAOIFN)'>0 $$IPVE^RAERR("RAOIFN")
S IENS=(+RAOIFN)_","
D GETS^DIQ(75.1,IENS,"5","EI","RABUF","RAMSG")
Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,75.1,IENS)
Q $G(RABUF(75.1,IENS,5,"I"))_U_$G(RABUF(75.1,IENS,5,"E"))
;
;***** PERFORMS ORDER STATUS 'ROLLBACK"
;
; RAOIFN IEN of the exam order in the RAD/NUC MED ORDERS
; file (#75.1)
;
; STATUS Internal status value (see the REQUEST STATUS field
; (5) of the file #75.1 and the NEW STATUS field (2)
; of the sub-file #75.12).
; Return Values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Success
;
OSTRLBCK(RAOIFN,STATUS) ;
N RALOCK,RANODE,RARC,TMP
Q:$G(RAOIFN)'>0 $$IPVE^RAERR("RAOIFN")
Q:$G(STATUS)="" $$IPVE^RAERR("STATUS")
S RAOIFN=+RAOIFN,RANODE=$$ROOT^DILFD(75.12,","_RAOIFN_",",1)
S RARC=0
;
;--- 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,DA,DIK,IENS,RAFDA,RAIEN,RAIENRS,RAMSG
. ;--- Setup the error processing
. D SETDEFEH^RAERR("RARC")
. ;--- Find the latest record with requested status
. S RAIENRS=" "
. F S RAIENRS=$O(@RANODE@(RAIENRS),-1) Q:RAIENRS'>0 D Q:TMP
. . S TMP=RAIENRS_","_RAOIFN_","
. . S TMP=($$GET1^DIQ(75.12,TMP,2,"I",,"RAMSG")=STATUS)
. ;--- If the requested status is not found in the multiple,
. ;--- use the regular status update function to fix it.
. I RAIENRS'>0 S RARC=$$UPDORDST(RAOIFN,STATUS) Q
. ;--- Delete record(s) from the multiple
. S DIK=$$OREF^DILF(RANODE),RAIEN=" "
. F S RAIEN=$O(@RANODE@(RAIEN),-1) Q:RAIEN'>RAIENRS D
. . S DA(1)=RAOIFN,DA=RAIEN D ^DIK
. ;--- Update status and cancel/hold reason
. S IENS=RAOIFN_","
. S RAFDA(75.1,IENS,5)=STATUS
. S TMP=$$GET1^DIQ(75.12,RAIENRS_","_IENS,4,"I",,"RAMSG")
. S RAFDA(75.1,IENS,10)=$S('$G(DIERR):TMP,1:"")
. D FILE^DIE(,"RAFDA","RAMSG")
. S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,75.12,RAIENRS_",")
;
;--- Error handling and cleanup
D UNLOCKFM^RALOCK(.RALOCK)
Q $S(RARC<0:RARC,1:0)
;
;***** UPDATES THE ORDER/REQUEST STATUS
;
; RAOIFN IEN of the exam order in the RAD/NUC MED ORDERS
; file (#75.1)
;
; STATUS Internal status value (see the REQUEST STATUS field
; (5) of the file #75.1 and the NEW STATUS field (2)
; of the sub-file #75.12).
;
; [REASON] 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).
;
; This parameter is required if STATUS=1 or STATUS=3.
;
; The referenced record must have the appropriate
; type of reason (see TYPE OF REASON field (2) of
; the file #75.2): CANCEL REQUEST (1) if STATUS=1,
; HOLD REQUEST (3) if STATUS=3, or GENERAL REQUEST (9)
; in both cases.
;
; [SCDT] Internal date value (FileMan) for the STATUS CHANGE
; DATE/TIME field (.01) of the sub-file #75.12. If
; this parameter is not defined or not greater than 0,
; then the current date/time is used.
;
; Return Values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Order already has the requested status
; >0 IEN of the new status sub-record in sub-file #75.12
;
UPDORDST(RAOIFN,STATUS,REASON,SCDT) ;
N IENS,RAFDA,RAIENS,RALOCK,RAMSG,RAOSTS,RARC,RTYPE,SCEDT,TMP
Q:$G(RAOIFN)'>0 $$IPVE^RAERR("RAOIFN")
Q:$G(STATUS)="" $$IPVE^RAERR("STATUS")
S RARC=0,RAOIFN=+RAOIFN
;
;=== Check the Cancel/Hold reason
I (STATUS=1)!(STATUS=3) D Q:RARC<0 RARC
. ;--- Variable for the EN^RABUL, which is called from the
. ; input transform of the REQUEST STATUS field (5) of
. ;--- the RAD/NUC MED ORDERS file (#75.1)
. S RAOSTS=STATUS
. ;--- Check if it has a value
. I $G(REASON)="" S RARC=$$ERROR^RAERR(-8,,"REASON") Q
. ;--- Get the IEN and type of the reason
. S RARC=$$RARSNIEN^RAMAGU13(REASON,.RTYPE) Q:RARC<0
. S REASON="`"_(+RARC) ; Pseudo-external value
. ;--- Check the type of reason
. S TMP=+RTYPE
. I TMP'=STATUS,TMP'=9 D Q
. . S RARC=$$ERROR^RAERR(-16,,+RTYPE,STATUS)
E S REASON=""
;
;=== Check the date/time
I $G(SCDT)>0 D Q:RARC<0 RARC
. S TMP=+$E(SCDT,1,12),SCEDT=$$FMTE^XLFDT(TMP)
. S:(SCEDT=TMP)!(SCEDT="") RARC=$$IPVE^RAERR("SCDT")
E S SCEDT="NOW"
;
;=== Prepare the data
S IENS=RAOIFN_","
S RAFDA(75.1,IENS,5)=STATUS ; REQUEST STATUS
S RAFDA(75.1,IENS,10)=REASON ; REASON
S RAFDA(75.1,IENS,18)="NOW" ; LAST ACTIVITY DATE/TIME
S:STATUS'=3 RAFDA(75.1,IENS,25)="@" ; HOLD DESCRIPTION
S IENS="+1,"_IENS
S RAFDA(75.12,IENS,.01)=SCEDT ; REQUEST STATUS TIMES
S RAFDA(75.12,IENS,2)=STATUS ; NEW STATUS
S RAFDA(75.12,IENS,3)="`"_(+DUZ) ; COMPUTER USER
S RAFDA(75.12,IENS,4)=REASON ; REASON
;
;=== 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 if the order currently has the same status
. S TMP=$$GET1^DIQ(75.1,RAOIFN_",",5,"I",,"RAMSG")
. I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9,75.1,RAOIFN_",") Q
. I STATUS=TMP S RARC=0 D Q:RARC
. . ;--- Check if the last record of the REQUEST STATUS TIMES
. . ;--- multiple indicates the same status as the requested one
. . S IENS=+$O(^RAO(75.1,RAOIFN,"T"," "),-1) Q:IENS'>0
. . S IENS=IENS_","_RAOIFN_","
. . S TMP=$$GET1^DIQ(75.12,IENS,2,"I",,"RAMSG")
. . I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9,75.12,IENS) Q
. . S RARC=(TMP=STATUS)
. ;
. ;=== Update the record
. D UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
. S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,75.12,IENS)
;
;=== Error handling and cleanup
D UNLOCKFM^RALOCK(.RALOCK)
Q $S(RARC<0:RARC,1:+$G(RAIENS(1)))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAGU02 6677 printed Apr 09, 2024@21:37:16 Page 2
RAMAGU02 ;HCIOFO/SG - ORDERS/EXAMS API (ORDER UTILITIES) ; 1/24/08 5:37pm
+1 ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
+2 ;
+3 QUIT
+4 ;
+5 ;##### RETURNS ORDER STATUS
+6 ;
+7 ; RAOIFN IEN of the exam order in the RAD/NUC MED ORDERS
+8 ; file (#75.1)
+9 ;
+10 ; Return Values:
+11 ; <0 Error descriptor (see $$ERROR^RAERR)
+12 ; ... Internal and external values of the order status
+13 ; separated by "^"
+14 ;
ORDSTAT(RAOIFN) ;
+1 NEW IENS,RABUF,RAMSG
+2 if $GET(RAOIFN)'>0
QUIT $$IPVE^RAERR("RAOIFN")
+3 SET IENS=(+RAOIFN)_","
+4 DO GETS^DIQ(75.1,IENS,"5","EI","RABUF","RAMSG")
+5 if $GET(DIERR)
QUIT $$DBS^RAERR("RAMSG",-9,75.1,IENS)
+6 QUIT $GET(RABUF(75.1,IENS,5,"I"))_U_$GET(RABUF(75.1,IENS,5,"E"))
+7 ;
+8 ;***** PERFORMS ORDER STATUS 'ROLLBACK"
+9 ;
+10 ; RAOIFN IEN of the exam order in the RAD/NUC MED ORDERS
+11 ; file (#75.1)
+12 ;
+13 ; STATUS Internal status value (see the REQUEST STATUS field
+14 ; (5) of the file #75.1 and the NEW STATUS field (2)
+15 ; of the sub-file #75.12).
+16 ; Return Values:
+17 ; <0 Error descriptor (see $$ERROR^RAERR)
+18 ; 0 Success
+19 ;
OSTRLBCK(RAOIFN,STATUS) ;
+1 NEW RALOCK,RANODE,RARC,TMP
+2 if $GET(RAOIFN)'>0
QUIT $$IPVE^RAERR("RAOIFN")
+3 if $GET(STATUS)=""
QUIT $$IPVE^RAERR("STATUS")
+4 SET RAOIFN=+RAOIFN
SET RANODE=$$ROOT^DILFD(75.12,","_RAOIFN_",",1)
+5 SET RARC=0
+6 ;
+7 ;--- Lock the order record
+8 KILL TMP
SET TMP(75.1,RAOIFN_",")=""
+9 SET RARC=$$LOCKFM^RALOCK(.TMP)
+10 if RARC
QUIT $$LOCKERR^RAERR(RARC,"order")
+11 MERGE RALOCK=TMP
+12 ;
+13 Begin DoDot:1
+14 NEW $ESTACK,$ETRAP,DA,DIK,IENS,RAFDA,RAIEN,RAIENRS,RAMSG
+15 ;--- Setup the error processing
+16 DO SETDEFEH^RAERR("RARC")
+17 ;--- Find the latest record with requested status
+18 SET RAIENRS=" "
+19 FOR
SET RAIENRS=$ORDER(@RANODE@(RAIENRS),-1)
if RAIENRS'>0
QUIT
Begin DoDot:2
+20 SET TMP=RAIENRS_","_RAOIFN_","
+21 SET TMP=($$GET1^DIQ(75.12,TMP,2,"I",,"RAMSG")=STATUS)
End DoDot:2
if TMP
QUIT
+22 ;--- If the requested status is not found in the multiple,
+23 ;--- use the regular status update function to fix it.
+24 IF RAIENRS'>0
SET RARC=$$UPDORDST(RAOIFN,STATUS)
QUIT
+25 ;--- Delete record(s) from the multiple
+26 SET DIK=$$OREF^DILF(RANODE)
SET RAIEN=" "
+27 FOR
SET RAIEN=$ORDER(@RANODE@(RAIEN),-1)
if RAIEN'>RAIENRS
QUIT
Begin DoDot:2
+28 SET DA(1)=RAOIFN
SET DA=RAIEN
DO ^DIK
End DoDot:2
+29 ;--- Update status and cancel/hold reason
+30 SET IENS=RAOIFN_","
+31 SET RAFDA(75.1,IENS,5)=STATUS
+32 SET TMP=$$GET1^DIQ(75.12,RAIENRS_","_IENS,4,"I",,"RAMSG")
+33 SET RAFDA(75.1,IENS,10)=$SELECT('$GET(DIERR):TMP,1:"")
+34 DO FILE^DIE(,"RAFDA","RAMSG")
+35 if $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,75.12,RAIENRS_",")
End DoDot:1
+36 ;
+37 ;--- Error handling and cleanup
+38 DO UNLOCKFM^RALOCK(.RALOCK)
+39 QUIT $SELECT(RARC<0:RARC,1:0)
+40 ;
+41 ;***** UPDATES THE ORDER/REQUEST STATUS
+42 ;
+43 ; RAOIFN IEN of the exam order in the RAD/NUC MED ORDERS
+44 ; file (#75.1)
+45 ;
+46 ; STATUS Internal status value (see the REQUEST STATUS field
+47 ; (5) of the file #75.1 and the NEW STATUS field (2)
+48 ; of the sub-file #75.12).
+49 ;
+50 ; [REASON] Cancel/Hold reason: either IEN of a record of
+51 ; the RAD/NUC MED REASON file (#75.2) or a valid
+52 ; synonym (see SYNONYM field (3) of that file).
+53 ;
+54 ; This parameter is required if STATUS=1 or STATUS=3.
+55 ;
+56 ; The referenced record must have the appropriate
+57 ; type of reason (see TYPE OF REASON field (2) of
+58 ; the file #75.2): CANCEL REQUEST (1) if STATUS=1,
+59 ; HOLD REQUEST (3) if STATUS=3, or GENERAL REQUEST (9)
+60 ; in both cases.
+61 ;
+62 ; [SCDT] Internal date value (FileMan) for the STATUS CHANGE
+63 ; DATE/TIME field (.01) of the sub-file #75.12. If
+64 ; this parameter is not defined or not greater than 0,
+65 ; then the current date/time is used.
+66 ;
+67 ; Return Values:
+68 ; <0 Error descriptor (see $$ERROR^RAERR)
+69 ; 0 Order already has the requested status
+70 ; >0 IEN of the new status sub-record in sub-file #75.12
+71 ;
UPDORDST(RAOIFN,STATUS,REASON,SCDT) ;
+1 NEW IENS,RAFDA,RAIENS,RALOCK,RAMSG,RAOSTS,RARC,RTYPE,SCEDT,TMP
+2 if $GET(RAOIFN)'>0
QUIT $$IPVE^RAERR("RAOIFN")
+3 if $GET(STATUS)=""
QUIT $$IPVE^RAERR("STATUS")
+4 SET RARC=0
SET RAOIFN=+RAOIFN
+5 ;
+6 ;=== Check the Cancel/Hold reason
+7 IF (STATUS=1)!(STATUS=3)
Begin DoDot:1
+8 ;--- Variable for the EN^RABUL, which is called from the
+9 ; input transform of the REQUEST STATUS field (5) of
+10 ;--- the RAD/NUC MED ORDERS file (#75.1)
+11 SET RAOSTS=STATUS
+12 ;--- Check if it has a value
+13 IF $GET(REASON)=""
SET RARC=$$ERROR^RAERR(-8,,"REASON")
QUIT
+14 ;--- Get the IEN and type of the reason
+15 SET RARC=$$RARSNIEN^RAMAGU13(REASON,.RTYPE)
if RARC<0
QUIT
+16 ; Pseudo-external value
SET REASON="`"_(+RARC)
+17 ;--- Check the type of reason
+18 SET TMP=+RTYPE
+19 IF TMP'=STATUS
IF TMP'=9
Begin DoDot:2
+20 SET RARC=$$ERROR^RAERR(-16,,+RTYPE,STATUS)
End DoDot:2
QUIT
End DoDot:1
if RARC<0
QUIT RARC
+21 IF '$TEST
SET REASON=""
+22 ;
+23 ;=== Check the date/time
+24 IF $GET(SCDT)>0
Begin DoDot:1
+25 SET TMP=+$EXTRACT(SCDT,1,12)
SET SCEDT=$$FMTE^XLFDT(TMP)
+26 if (SCEDT=TMP)!(SCEDT="")
SET RARC=$$IPVE^RAERR("SCDT")
End DoDot:1
if RARC<0
QUIT RARC
+27 IF '$TEST
SET SCEDT="NOW"
+28 ;
+29 ;=== Prepare the data
+30 SET IENS=RAOIFN_","
+31 ; REQUEST STATUS
SET RAFDA(75.1,IENS,5)=STATUS
+32 ; REASON
SET RAFDA(75.1,IENS,10)=REASON
+33 ; LAST ACTIVITY DATE/TIME
SET RAFDA(75.1,IENS,18)="NOW"
+34 ; HOLD DESCRIPTION
if STATUS'=3
SET RAFDA(75.1,IENS,25)="@"
+35 SET IENS="+1,"_IENS
+36 ; REQUEST STATUS TIMES
SET RAFDA(75.12,IENS,.01)=SCEDT
+37 ; NEW STATUS
SET RAFDA(75.12,IENS,2)=STATUS
+38 ; COMPUTER USER
SET RAFDA(75.12,IENS,3)="`"_(+DUZ)
+39 ; REASON
SET RAFDA(75.12,IENS,4)=REASON
+40 ;
+41 ;=== Lock the order record
+42 KILL TMP
SET TMP(75.1,RAOIFN_",")=""
+43 SET RARC=$$LOCKFM^RALOCK(.TMP)
+44 if RARC
QUIT $$LOCKERR^RAERR(RARC,"order")
+45 MERGE RALOCK=TMP
+46 ;
+47 Begin DoDot:1
+48 NEW $ESTACK,$ETRAP
+49 ;=== Setup the error processing
+50 DO SETDEFEH^RAERR("RARC")
+51 ;
+52 ;=== Check if the order currently has the same status
+53 SET TMP=$$GET1^DIQ(75.1,RAOIFN_",",5,"I",,"RAMSG")
+54 IF $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,75.1,RAOIFN_",")
QUIT
+55 IF STATUS=TMP
SET RARC=0
Begin DoDot:2
+56 ;--- Check if the last record of the REQUEST STATUS TIMES
+57 ;--- multiple indicates the same status as the requested one
+58 SET IENS=+$ORDER(^RAO(75.1,RAOIFN,"T"," "),-1)
if IENS'>0
QUIT
+59 SET IENS=IENS_","_RAOIFN_","
+60 SET TMP=$$GET1^DIQ(75.12,IENS,2,"I",,"RAMSG")
+61 IF $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,75.12,IENS)
QUIT
+62 SET RARC=(TMP=STATUS)
End DoDot:2
if RARC
QUIT
+63 ;
+64 ;=== Update the record
+65 DO UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
+66 if $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,75.12,IENS)
End DoDot:1
+67 ;
+68 ;=== Error handling and cleanup
+69 DO UNLOCKFM^RALOCK(.RALOCK)
+70 QUIT $SELECT(RARC<0:RARC,1:+$GET(RAIENS(1)))
