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

RAMAGU05.m

Go to the documentation of this file.
  1. RAMAGU05 ;HCIOFO/SG - ORDERS/EXAMS API (EXAM UTILITIES) ; 5/27/08 2:16pm
  1. ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
  1. ;
  1. Q
  1. ;
  1. ;##### RETURNS EXAM STATUS
  1. ;
  1. ; RACASE Examination identifiers
  1. ; ^01: IEN of the patient in the file #70 (RADFN)
  1. ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
  1. ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
  1. ;
  1. ; Return Values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; >0 Exam status descriptor (see the ^RAMAGU06)
  1. ;
  1. EXMSTAT(RACASE) ;
  1. N IEN72,IENS,RABUF,RAMSG,RC
  1. S RC=$$CHKEXMID^RAMAGU04(RACASE) Q:RC<0 RC
  1. ;--- Get the IEN of the status record
  1. S IENS=$$EXAMIENS^RAMAGU04(RACASE)
  1. S IEN72=$$GET1^DIQ(70.03,IENS,3,"I",,"RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.03,IENS)
  1. Q:IEN72'>0 $$ERROR^RAERR(-19,,70.03,IENS,3)
  1. ;--- Return the descriptor
  1. Q $$EXMSTINF^RAMAGU06(IEN72)
  1. ;
  1. ;***** UPDATES THE EXAM ACTIVITY LOG
  1. ;
  1. ; RACASE Examination identifiers
  1. ; ^01: IEN of the patient in the file #70 (RADFN)
  1. ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
  1. ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
  1. ;
  1. ; ACTION Internal action value (see the TYPE OF ACTION
  1. ; field (2) of the sub-file #70.07).
  1. ;
  1. ; [COMMENT] Optional value for the TECHNOLOGIST COMMENT
  1. ; field (4) of the sub-file #70.7.
  1. ;
  1. ; [LOGDT] Internal date value (FileMan) for the LOG DATE
  1. ; field (.01) of the sub-file #70.07. If this
  1. ; 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 IEN of the new activity sub-record in sub-file #70.07
  1. ;
  1. UPDEXMAL(RACASE,ACTION,COMMENT,LOGDT) ;
  1. N IENS,IENS7003,LOGDT1,RAFDA,RAIENS,RALOCK,RAMSG,RARC,TMP
  1. S RARC=$$CHKREQ^RAUTL22("RACASE,ACTION") Q:RARC<0 RARC
  1. S RARC=$$CHKEXMID^RAMAGU04(RACASE) Q:RARC<0 RARC
  1. S IENS7003=$$EXAMIENS^RAMAGU04(RACASE)
  1. ;
  1. ;--- Check the date/time
  1. I $G(LOGDT)>0 D Q:RARC<0 RARC
  1. . S TMP=+$E(LOGDT,1,12),LOGDT1=$$FMTE^XLFDT(TMP)
  1. . S:(LOGDT1=TMP)!(LOGDT1="") RARC=$$IPVE^RAERR("LOGDT")
  1. E S LOGDT1="NOW"
  1. ;
  1. ;--- Prepare the data
  1. S IENS="+1,"_IENS7003
  1. S RAFDA(70.07,IENS,.01)=LOGDT1 ; LOG DATE
  1. S RAFDA(70.07,IENS,2)=ACTION ; TYPE OF ACTION
  1. S RAFDA(70.07,IENS,3)="`"_(+DUZ) ; COMPUTER USER
  1. S RAFDA(70.07,IENS,4)=$G(COMMENT) ; TECHNOLOGIST COMMENT
  1. ;
  1. ;--- Lock the ACTIVITY LOG multiple
  1. K TMP S TMP(70.07,","_IENS7003)=""
  1. S RARC=$$LOCKFM^RALOCK(.TMP)
  1. Q:RARC $$LOCKERR^RAERR(RARC,"exam activity log")
  1. M RALOCK=TMP
  1. ;
  1. D
  1. . N $ESTACK,$ETRAP
  1. . ;--- Setup the error processing
  1. . D SETDEFEH^RAERR("RARC")
  1. . ;--- Add the record
  1. . D UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
  1. . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,70.07,IENS)
  1. ;
  1. ;--- Error handling and cleanup
  1. D UNLOCKFM^RALOCK(.RALOCK)
  1. Q $S(RARC<0:RARC,1:+RAIENS(1))
  1. ;
  1. ;***** UPDATES THE EXAM STATUS
  1. ;
  1. ; RACASE Examination identifiers
  1. ; ^01: IEN of the patient in the file #70 (RADFN)
  1. ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
  1. ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
  1. ;
  1. ; RASTAT Status identifier(s) in the format of the exam
  1. ; status descriptor (see the ^RAMAGU06 for details).
  1. ;
  1. ; NOTE: Imaging type required to find appropriate
  1. ; status record is extracted from the TYPE OF
  1. ; IMAGING field (2) of the sub-file #70.02.
  1. ;
  1. ; [RAFLAGS] Flags that control the execution (can be combined):
  1. ;
  1. ; F Force the new status even if not all required
  1. ; conditions (see $$EXMSTREQ^RAMAGU06) are met.
  1. ;
  1. ; [REASON] Cancellation 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 RASTAT=0.
  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) or GENERAL
  1. ; REQUEST (9).
  1. ;
  1. ; Return Values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Exam already has the requested status
  1. ; >0 IEN of the new record in the sub-file #70.05
  1. ;
  1. UPDEXMST(RACASE,RASTAT,RAFLAGS,REASON) ;
  1. N IENS,IENS7003,RAAFTER,RABEFORE,RABUF,RAFDA,RAIENS,RALOCK,RAMSG,RANODE,RARC,TMP
  1. S RARC=$$CHKREQ^RAUTL22("RACASE,RASTAT") Q:RARC<0 RARC
  1. S RARC=$$CHKEXMID^RAMAGU04(RACASE) Q:RARC<0 RARC
  1. S IENS7003=$$EXAMIENS^RAMAGU04(RACASE)
  1. S RAFLAGS=$G(RAFLAGS)
  1. ;
  1. ;=== If status order number is provided, it must be valid
  1. S TMP=$P(RASTAT,U,3)
  1. I TMP'="",(+TMP'=TMP)!(TMP<0)!(TMP>9) D Q RARC
  1. . S RARC=$$IPVE^RAERR("RASTAT")
  1. ;
  1. ;=== Validate the new exam status and get its descriptor
  1. I RASTAT'>0 D
  1. . S IENS=$P(IENS7003,",",2,99)
  1. . S TMP=$$GET1^DIQ(70.02,IENS,2,"I",,"RAMSG") ; TYPE OF IMAGING
  1. . I $G(DIERR) S RASTAT=$$DBS^RAERR("RAMSG",-9,70.02,IENS) Q
  1. . I TMP'>0 S RASTAT=$$ERROR^RAERR(-19,,70.02,IENS,2) Q
  1. . S RASTAT=$$EXMSTINF^RAMAGU06(RASTAT,TMP)
  1. E S RASTAT=$$EXMSTINF^RAMAGU06(RASTAT)
  1. Q:RASTAT<0 RASTAT
  1. ;
  1. ;=== Check the cancelation reason
  1. I $P(RASTAT,U,3)=0 D Q:RARC<0 RARC
  1. . N RTYPE
  1. . ;--- Check if it has a value
  1. . I $G(REASON)="" S RARC=$$ERROR^RAERR(-8,,"REASON") Q
  1. . ;--- Find the IEN of the synonym
  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'=1,TMP'=9 D Q
  1. . . S RARC=$$ERROR^RAERR(-16,,$P(RTYPE,U,2),$P(RASTAT,U,2))
  1. E S REASON=""
  1. ;
  1. ;=== Lock the exam
  1. K TMP S TMP(70.03,IENS7003)=""
  1. S RARC=$$LOCKFM^RALOCK(.TMP)
  1. Q:RARC $$LOCKERR^RAERR(RARC,"examination")
  1. M RALOCK=TMP
  1. ;
  1. D
  1. . N $ESTACK,$ETRAP,RAOVER,ZTQUEUED
  1. . S ZTQUEUED=1 ; Silence EXAM STATUS input transform (^RASTREQ)
  1. . ;=== Setup the error processing
  1. . D SETDEFEH^RAERR("RARC")
  1. . ;
  1. . ;=== Check if the exam currently has the same status
  1. . S TMP=$$GET1^DIQ(70.03,IENS7003,3,"I",,"RAMSG")
  1. . I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9,70.03,IENS7003) Q
  1. . Q:+RASTAT=TMP
  1. . ;
  1. . ;=== Execute the input transform and the ^RASTREQ routine
  1. . I RAFLAGS'["F" D Q:RARC<0
  1. . . D VAL^DIE(70.03,IENS7003,3,,"`"_(+RASTAT),.TMP,,"RAMSG")
  1. . . I TMP="^" S RARC=$$IPVE^RAERR("RASTAT") Q
  1. . . Q:$G(RAAFTER)=$P(RASTAT,U,3)
  1. . . S RARC=$$ERROR^RAERR(-31,"RACASE='"_RACASE_"'",$P(RASTAT,U,2))
  1. . ;
  1. . ;=== Prepare the data
  1. . S IENS=IENS7003
  1. . S RAFDA(70.03,IENS,3)="`"_(+RASTAT) ; EXAM STATUS
  1. . S RAFDA(70.03,IENS,3.5)=REASON ; REASON FOR CANCELLATION
  1. . S IENS="+1,"_IENS7003
  1. . S RAFDA(70.05,IENS,.01)="NOW" ; STATUS CHANGE DATE/TIME
  1. . S RAFDA(70.05,IENS,2)="`"_(+RASTAT) ; NEW STATUS
  1. . S RAFDA(70.05,IENS,3)="`"_(+DUZ) ; COMPUTER USER
  1. . ;
  1. . ;=== Update the record
  1. . D UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
  1. . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,70.05,IENS)
  1. ;
  1. ;=== Error handling and cleanup
  1. D UNLOCKFM^RALOCK(.RALOCK)
  1. Q $S(RARC<0:RARC,1:+$G(RAIENS(1)))