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

RAMAGU02.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  Q
  1.  ;
  1.  ;##### RETURNS ORDER STATUS
  1.  ;
  1.  ; RAOIFN        IEN of the exam order in the RAD/NUC MED ORDERS
  1.  ;               file (#75.1)
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error descriptor (see $$ERROR^RAERR)
  1.  ;      ...  Internal and external values of the order status
  1.  ;           separated by "^"
  1.  ;
  1. ORDSTAT(RAOIFN) ;
  1.  N IENS,RABUF,RAMSG
  1.  Q:$G(RAOIFN)'>0 $$IPVE^RAERR("RAOIFN")
  1.  S IENS=(+RAOIFN)_","
  1.  D GETS^DIQ(75.1,IENS,"5","EI","RABUF","RAMSG")
  1.  Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,75.1,IENS)
  1.  Q $G(RABUF(75.1,IENS,5,"I"))_U_$G(RABUF(75.1,IENS,5,"E"))
  1.  ;
  1.  ;***** PERFORMS ORDER STATUS 'ROLLBACK"
  1.  ;
  1.  ; RAOIFN        IEN of the exam order in the RAD/NUC MED ORDERS
  1.  ;               file (#75.1)
  1.  ;
  1.  ; STATUS        Internal status value (see the REQUEST STATUS field
  1.  ;               (5) of the file #75.1 and the NEW STATUS field (2)
  1.  ;               of the sub-file #75.12).
  1.  ; Return Values:
  1.  ;       <0  Error descriptor (see $$ERROR^RAERR)
  1.  ;        0  Success
  1.  ;
  1. OSTRLBCK(RAOIFN,STATUS) ;
  1.  N RALOCK,RANODE,RARC,TMP
  1.  Q:$G(RAOIFN)'>0 $$IPVE^RAERR("RAOIFN")
  1.  Q:$G(STATUS)="" $$IPVE^RAERR("STATUS")
  1.  S RAOIFN=+RAOIFN,RANODE=$$ROOT^DILFD(75.12,","_RAOIFN_",",1)
  1.  S RARC=0
  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,DA,DIK,IENS,RAFDA,RAIEN,RAIENRS,RAMSG
  1.  . ;--- Setup the error processing
  1.  . D SETDEFEH^RAERR("RARC")
  1.  . ;--- Find the latest record with requested status
  1.  . S RAIENRS=" "
  1.  . F  S RAIENRS=$O(@RANODE@(RAIENRS),-1)  Q:RAIENRS'>0  D  Q:TMP
  1.  . . S TMP=RAIENRS_","_RAOIFN_","
  1.  . . S TMP=($$GET1^DIQ(75.12,TMP,2,"I",,"RAMSG")=STATUS)
  1.  . ;--- If the requested status is not found in the multiple,
  1.  . ;--- use the regular status update function to fix it.
  1.  . I RAIENRS'>0  S RARC=$$UPDORDST(RAOIFN,STATUS)  Q
  1.  . ;--- Delete record(s) from the multiple
  1.  . S DIK=$$OREF^DILF(RANODE),RAIEN=" "
  1.  . F  S RAIEN=$O(@RANODE@(RAIEN),-1)  Q:RAIEN'>RAIENRS  D
  1.  . . S DA(1)=RAOIFN,DA=RAIEN  D ^DIK
  1.  . ;--- Update status and cancel/hold reason
  1.  . S IENS=RAOIFN_","
  1.  . S RAFDA(75.1,IENS,5)=STATUS
  1.  . S TMP=$$GET1^DIQ(75.12,RAIENRS_","_IENS,4,"I",,"RAMSG")
  1.  . S RAFDA(75.1,IENS,10)=$S('$G(DIERR):TMP,1:"")
  1.  . D FILE^DIE(,"RAFDA","RAMSG")
  1.  . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,75.12,RAIENRS_",")
  1.  ;
  1.  ;--- Error handling and cleanup
  1.  D UNLOCKFM^RALOCK(.RALOCK)
  1.  Q $S(RARC<0:RARC,1:0)
  1.  ;
  1.  ;***** UPDATES THE ORDER/REQUEST STATUS
  1.  ;
  1.  ; RAOIFN        IEN of the exam order in the RAD/NUC MED ORDERS
  1.  ;               file (#75.1)
  1.  ;
  1.  ; STATUS        Internal status value (see the REQUEST STATUS field
  1.  ;               (5) of the file #75.1 and the NEW STATUS field (2)
  1.  ;               of the sub-file #75.12).
  1.  ;
  1.  ; [REASON]      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.  ;               This parameter is required if STATUS=1 or STATUS=3.
  1.  ;
  1.  ;               The referenced record must have the appropriate
  1.  ;               type of reason (see TYPE OF REASON field (2) of
  1.  ;               the file #75.2): CANCEL REQUEST (1) if STATUS=1,
  1.  ;               HOLD REQUEST (3) if STATUS=3, or GENERAL REQUEST (9)
  1.  ;               in both cases.
  1.  ;
  1.  ; [SCDT]        Internal date value (FileMan) for the STATUS CHANGE
  1.  ;               DATE/TIME field (.01) of the sub-file #75.12. If
  1.  ;               this parameter is not defined or not greater than 0, 
  1.  ;               then the current date/time is used.
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error descriptor (see $$ERROR^RAERR)
  1.  ;        0  Order already has the requested status
  1.  ;       >0  IEN of the new status sub-record in sub-file #75.12
  1.  ;
  1. UPDORDST(RAOIFN,STATUS,REASON,SCDT) ;
  1.  N IENS,RAFDA,RAIENS,RALOCK,RAMSG,RAOSTS,RARC,RTYPE,SCEDT,TMP
  1.  Q:$G(RAOIFN)'>0 $$IPVE^RAERR("RAOIFN")
  1.  Q:$G(STATUS)="" $$IPVE^RAERR("STATUS")
  1.  S RARC=0,RAOIFN=+RAOIFN
  1.  ;
  1.  ;=== Check the Cancel/Hold reason
  1.  I (STATUS=1)!(STATUS=3)  D  Q:RARC<0 RARC
  1.  . ;--- Variable for the EN^RABUL, which is called from the
  1.  . ;    input transform of the REQUEST STATUS field (5) of
  1.  . ;--- the RAD/NUC MED ORDERS file (#75.1)
  1.  . S RAOSTS=STATUS
  1.  . ;--- Check if it has a value
  1.  . I $G(REASON)=""  S RARC=$$ERROR^RAERR(-8,,"REASON")  Q
  1.  . ;--- Get the IEN and type of the reason
  1.  . S RARC=$$RARSNIEN^RAMAGU13(REASON,.RTYPE)  Q:RARC<0
  1.  . S REASON="`"_(+RARC)  ; Pseudo-external value
  1.  . ;--- Check the type of reason
  1.  . S TMP=+RTYPE
  1.  . I TMP'=STATUS,TMP'=9  D  Q
  1.  . . S RARC=$$ERROR^RAERR(-16,,+RTYPE,STATUS)
  1.  E  S REASON=""
  1.  ;
  1.  ;=== Check the date/time
  1.  I $G(SCDT)>0  D  Q:RARC<0 RARC
  1.  . S TMP=+$E(SCDT,1,12),SCEDT=$$FMTE^XLFDT(TMP)
  1.  . S:(SCEDT=TMP)!(SCEDT="") RARC=$$IPVE^RAERR("SCDT")
  1.  E  S SCEDT="NOW"
  1.  ;
  1.  ;=== Prepare the data
  1.  S IENS=RAOIFN_","
  1.  S RAFDA(75.1,IENS,5)=STATUS               ; REQUEST STATUS
  1.  S RAFDA(75.1,IENS,10)=REASON              ; REASON
  1.  S RAFDA(75.1,IENS,18)="NOW"               ; LAST ACTIVITY DATE/TIME
  1.  S:STATUS'=3 RAFDA(75.1,IENS,25)="@"       ; HOLD DESCRIPTION
  1.  S IENS="+1,"_IENS
  1.  S RAFDA(75.12,IENS,.01)=SCEDT             ; REQUEST STATUS TIMES
  1.  S RAFDA(75.12,IENS,2)=STATUS              ; NEW STATUS
  1.  S RAFDA(75.12,IENS,3)="`"_(+DUZ)          ; COMPUTER USER
  1.  S RAFDA(75.12,IENS,4)=REASON              ; REASON
  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 if the order currently has the same status
  1.  . S TMP=$$GET1^DIQ(75.1,RAOIFN_",",5,"I",,"RAMSG")
  1.  . I $G(DIERR)  S RARC=$$DBS^RAERR("RAMSG",-9,75.1,RAOIFN_",")  Q
  1.  . I STATUS=TMP  S RARC=0  D  Q:RARC
  1.  . . ;--- Check if the last record of the REQUEST STATUS TIMES
  1.  . . ;--- multiple indicates the same status as the requested one
  1.  . . S IENS=+$O(^RAO(75.1,RAOIFN,"T"," "),-1)  Q:IENS'>0
  1.  . . S IENS=IENS_","_RAOIFN_","
  1.  . . S TMP=$$GET1^DIQ(75.12,IENS,2,"I",,"RAMSG")
  1.  . . I $G(DIERR)  S RARC=$$DBS^RAERR("RAMSG",-9,75.12,IENS)  Q
  1.  . . S RARC=(TMP=STATUS)
  1.  . ;
  1.  . ;=== Update the record
  1.  . D UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
  1.  . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,75.12,IENS)
  1.  ;
  1.  ;=== Error handling and cleanup
  1.  D UNLOCKFM^RALOCK(.RALOCK)
  1.  Q $S(RARC<0:RARC,1:+$G(RAIENS(1)))