- RAMAGU05 ;HCIOFO/SG - ORDERS/EXAMS API (EXAM UTILITIES) ; 5/27/08 2:16pm
- ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
- ;
- Q
- ;
- ;##### RETURNS EXAM STATUS
- ;
- ; RACASE Examination identifiers
- ; ^01: IEN of the patient in the file #70 (RADFN)
- ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
- ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
- ;
- ; Return Values:
- ; <0 Error descriptor (see $$ERROR^RAERR)
- ; >0 Exam status descriptor (see the ^RAMAGU06)
- ;
- EXMSTAT(RACASE) ;
- N IEN72,IENS,RABUF,RAMSG,RC
- S RC=$$CHKEXMID^RAMAGU04(RACASE) Q:RC<0 RC
- ;--- Get the IEN of the status record
- S IENS=$$EXAMIENS^RAMAGU04(RACASE)
- S IEN72=$$GET1^DIQ(70.03,IENS,3,"I",,"RAMSG")
- Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.03,IENS)
- Q:IEN72'>0 $$ERROR^RAERR(-19,,70.03,IENS,3)
- ;--- Return the descriptor
- Q $$EXMSTINF^RAMAGU06(IEN72)
- ;
- ;***** UPDATES THE EXAM ACTIVITY LOG
- ;
- ; RACASE Examination identifiers
- ; ^01: IEN of the patient in the file #70 (RADFN)
- ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
- ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
- ;
- ; ACTION Internal action value (see the TYPE OF ACTION
- ; field (2) of the sub-file #70.07).
- ;
- ; [COMMENT] Optional value for the TECHNOLOGIST COMMENT
- ; field (4) of the sub-file #70.7.
- ;
- ; [LOGDT] Internal date value (FileMan) for the LOG DATE
- ; field (.01) of the sub-file #70.07. 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 IEN of the new activity sub-record in sub-file #70.07
- ;
- UPDEXMAL(RACASE,ACTION,COMMENT,LOGDT) ;
- N IENS,IENS7003,LOGDT1,RAFDA,RAIENS,RALOCK,RAMSG,RARC,TMP
- S RARC=$$CHKREQ^RAUTL22("RACASE,ACTION") Q:RARC<0 RARC
- S RARC=$$CHKEXMID^RAMAGU04(RACASE) Q:RARC<0 RARC
- S IENS7003=$$EXAMIENS^RAMAGU04(RACASE)
- ;
- ;--- Check the date/time
- I $G(LOGDT)>0 D Q:RARC<0 RARC
- . S TMP=+$E(LOGDT,1,12),LOGDT1=$$FMTE^XLFDT(TMP)
- . S:(LOGDT1=TMP)!(LOGDT1="") RARC=$$IPVE^RAERR("LOGDT")
- E S LOGDT1="NOW"
- ;
- ;--- Prepare the data
- S IENS="+1,"_IENS7003
- S RAFDA(70.07,IENS,.01)=LOGDT1 ; LOG DATE
- S RAFDA(70.07,IENS,2)=ACTION ; TYPE OF ACTION
- S RAFDA(70.07,IENS,3)="`"_(+DUZ) ; COMPUTER USER
- S RAFDA(70.07,IENS,4)=$G(COMMENT) ; TECHNOLOGIST COMMENT
- ;
- ;--- Lock the ACTIVITY LOG multiple
- K TMP S TMP(70.07,","_IENS7003)=""
- S RARC=$$LOCKFM^RALOCK(.TMP)
- Q:RARC $$LOCKERR^RAERR(RARC,"exam activity log")
- M RALOCK=TMP
- ;
- D
- . N $ESTACK,$ETRAP
- . ;--- Setup the error processing
- . D SETDEFEH^RAERR("RARC")
- . ;--- Add the record
- . D UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
- . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,70.07,IENS)
- ;
- ;--- Error handling and cleanup
- D UNLOCKFM^RALOCK(.RALOCK)
- Q $S(RARC<0:RARC,1:+RAIENS(1))
- ;
- ;***** UPDATES THE EXAM STATUS
- ;
- ; RACASE Examination identifiers
- ; ^01: IEN of the patient in the file #70 (RADFN)
- ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
- ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
- ;
- ; RASTAT Status identifier(s) in the format of the exam
- ; status descriptor (see the ^RAMAGU06 for details).
- ;
- ; NOTE: Imaging type required to find appropriate
- ; status record is extracted from the TYPE OF
- ; IMAGING field (2) of the sub-file #70.02.
- ;
- ; [RAFLAGS] Flags that control the execution (can be combined):
- ;
- ; F Force the new status even if not all required
- ; conditions (see $$EXMSTREQ^RAMAGU06) are met.
- ;
- ; [REASON] Cancellation 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 RASTAT=0.
- ;
- ; The referenced record must have the appropriate
- ; type of reason (see TYPE OF REASON field (2) of
- ; the file #75.2): CANCEL REQUEST (1) or GENERAL
- ; REQUEST (9).
- ;
- ; Return Values:
- ; <0 Error descriptor (see $$ERROR^RAERR)
- ; 0 Exam already has the requested status
- ; >0 IEN of the new record in the sub-file #70.05
- ;
- UPDEXMST(RACASE,RASTAT,RAFLAGS,REASON) ;
- N IENS,IENS7003,RAAFTER,RABEFORE,RABUF,RAFDA,RAIENS,RALOCK,RAMSG,RANODE,RARC,TMP
- S RARC=$$CHKREQ^RAUTL22("RACASE,RASTAT") Q:RARC<0 RARC
- S RARC=$$CHKEXMID^RAMAGU04(RACASE) Q:RARC<0 RARC
- S IENS7003=$$EXAMIENS^RAMAGU04(RACASE)
- S RAFLAGS=$G(RAFLAGS)
- ;
- ;=== If status order number is provided, it must be valid
- S TMP=$P(RASTAT,U,3)
- I TMP'="",(+TMP'=TMP)!(TMP<0)!(TMP>9) D Q RARC
- . S RARC=$$IPVE^RAERR("RASTAT")
- ;
- ;=== Validate the new exam status and get its descriptor
- I RASTAT'>0 D
- . S IENS=$P(IENS7003,",",2,99)
- . S TMP=$$GET1^DIQ(70.02,IENS,2,"I",,"RAMSG") ; TYPE OF IMAGING
- . I $G(DIERR) S RASTAT=$$DBS^RAERR("RAMSG",-9,70.02,IENS) Q
- . I TMP'>0 S RASTAT=$$ERROR^RAERR(-19,,70.02,IENS,2) Q
- . S RASTAT=$$EXMSTINF^RAMAGU06(RASTAT,TMP)
- E S RASTAT=$$EXMSTINF^RAMAGU06(RASTAT)
- Q:RASTAT<0 RASTAT
- ;
- ;=== Check the cancelation reason
- I $P(RASTAT,U,3)=0 D Q:RARC<0 RARC
- . N RTYPE
- . ;--- Check if it has a value
- . I $G(REASON)="" S RARC=$$ERROR^RAERR(-8,,"REASON") Q
- . ;--- Find the IEN of the synonym
- . 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'=1,TMP'=9 D Q
- . . S RARC=$$ERROR^RAERR(-16,,$P(RTYPE,U,2),$P(RASTAT,U,2))
- E S REASON=""
- ;
- ;=== Lock the exam
- K TMP S TMP(70.03,IENS7003)=""
- S RARC=$$LOCKFM^RALOCK(.TMP)
- Q:RARC $$LOCKERR^RAERR(RARC,"examination")
- M RALOCK=TMP
- ;
- D
- . N $ESTACK,$ETRAP,RAOVER,ZTQUEUED
- . S ZTQUEUED=1 ; Silence EXAM STATUS input transform (^RASTREQ)
- . ;=== Setup the error processing
- . D SETDEFEH^RAERR("RARC")
- . ;
- . ;=== Check if the exam currently has the same status
- . S TMP=$$GET1^DIQ(70.03,IENS7003,3,"I",,"RAMSG")
- . I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9,70.03,IENS7003) Q
- . Q:+RASTAT=TMP
- . ;
- . ;=== Execute the input transform and the ^RASTREQ routine
- . I RAFLAGS'["F" D Q:RARC<0
- . . D VAL^DIE(70.03,IENS7003,3,,"`"_(+RASTAT),.TMP,,"RAMSG")
- . . I TMP="^" S RARC=$$IPVE^RAERR("RASTAT") Q
- . . Q:$G(RAAFTER)=$P(RASTAT,U,3)
- . . S RARC=$$ERROR^RAERR(-31,"RACASE='"_RACASE_"'",$P(RASTAT,U,2))
- . ;
- . ;=== Prepare the data
- . S IENS=IENS7003
- . S RAFDA(70.03,IENS,3)="`"_(+RASTAT) ; EXAM STATUS
- . S RAFDA(70.03,IENS,3.5)=REASON ; REASON FOR CANCELLATION
- . S IENS="+1,"_IENS7003
- . S RAFDA(70.05,IENS,.01)="NOW" ; STATUS CHANGE DATE/TIME
- . S RAFDA(70.05,IENS,2)="`"_(+RASTAT) ; NEW STATUS
- . S RAFDA(70.05,IENS,3)="`"_(+DUZ) ; COMPUTER USER
- . ;
- . ;=== Update the record
- . D UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
- . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,70.05,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[HRAMAGU05 7470 printed Jan 18, 2025@03:38:02 Page 2
- 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
- +2 ;
- +3 QUIT
- +4 ;
- +5 ;##### RETURNS EXAM STATUS
- +6 ;
- +7 ; RACASE Examination identifiers
- +8 ; ^01: IEN of the patient in the file #70 (RADFN)
- +9 ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
- +10 ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
- +11 ;
- +12 ; Return Values:
- +13 ; <0 Error descriptor (see $$ERROR^RAERR)
- +14 ; >0 Exam status descriptor (see the ^RAMAGU06)
- +15 ;
- EXMSTAT(RACASE) ;
- +1 NEW IEN72,IENS,RABUF,RAMSG,RC
- +2 SET RC=$$CHKEXMID^RAMAGU04(RACASE)
- if RC<0
- QUIT RC
- +3 ;--- Get the IEN of the status record
- +4 SET IENS=$$EXAMIENS^RAMAGU04(RACASE)
- +5 SET IEN72=$$GET1^DIQ(70.03,IENS,3,"I",,"RAMSG")
- +6 if $GET(DIERR)
- QUIT $$DBS^RAERR("RAMSG",-9,70.03,IENS)
- +7 if IEN72'>0
- QUIT $$ERROR^RAERR(-19,,70.03,IENS,3)
- +8 ;--- Return the descriptor
- +9 QUIT $$EXMSTINF^RAMAGU06(IEN72)
- +10 ;
- +11 ;***** UPDATES THE EXAM ACTIVITY LOG
- +12 ;
- +13 ; RACASE Examination identifiers
- +14 ; ^01: IEN of the patient in the file #70 (RADFN)
- +15 ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
- +16 ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
- +17 ;
- +18 ; ACTION Internal action value (see the TYPE OF ACTION
- +19 ; field (2) of the sub-file #70.07).
- +20 ;
- +21 ; [COMMENT] Optional value for the TECHNOLOGIST COMMENT
- +22 ; field (4) of the sub-file #70.7.
- +23 ;
- +24 ; [LOGDT] Internal date value (FileMan) for the LOG DATE
- +25 ; field (.01) of the sub-file #70.07. If this
- +26 ; parameter is not defined or not greater than 0,
- +27 ; then the current date/time is used.
- +28 ;
- +29 ; Return Values:
- +30 ; <0 Error descriptor (see $$ERROR^RAERR)
- +31 ; >0 IEN of the new activity sub-record in sub-file #70.07
- +32 ;
- UPDEXMAL(RACASE,ACTION,COMMENT,LOGDT) ;
- +1 NEW IENS,IENS7003,LOGDT1,RAFDA,RAIENS,RALOCK,RAMSG,RARC,TMP
- +2 SET RARC=$$CHKREQ^RAUTL22("RACASE,ACTION")
- if RARC<0
- QUIT RARC
- +3 SET RARC=$$CHKEXMID^RAMAGU04(RACASE)
- if RARC<0
- QUIT RARC
- +4 SET IENS7003=$$EXAMIENS^RAMAGU04(RACASE)
- +5 ;
- +6 ;--- Check the date/time
- +7 IF $GET(LOGDT)>0
- Begin DoDot:1
- +8 SET TMP=+$EXTRACT(LOGDT,1,12)
- SET LOGDT1=$$FMTE^XLFDT(TMP)
- +9 if (LOGDT1=TMP)!(LOGDT1="")
- SET RARC=$$IPVE^RAERR("LOGDT")
- End DoDot:1
- if RARC<0
- QUIT RARC
- +10 IF '$TEST
- SET LOGDT1="NOW"
- +11 ;
- +12 ;--- Prepare the data
- +13 SET IENS="+1,"_IENS7003
- +14 ; LOG DATE
- SET RAFDA(70.07,IENS,.01)=LOGDT1
- +15 ; TYPE OF ACTION
- SET RAFDA(70.07,IENS,2)=ACTION
- +16 ; COMPUTER USER
- SET RAFDA(70.07,IENS,3)="`"_(+DUZ)
- +17 ; TECHNOLOGIST COMMENT
- SET RAFDA(70.07,IENS,4)=$GET(COMMENT)
- +18 ;
- +19 ;--- Lock the ACTIVITY LOG multiple
- +20 KILL TMP
- SET TMP(70.07,","_IENS7003)=""
- +21 SET RARC=$$LOCKFM^RALOCK(.TMP)
- +22 if RARC
- QUIT $$LOCKERR^RAERR(RARC,"exam activity log")
- +23 MERGE RALOCK=TMP
- +24 ;
- +25 Begin DoDot:1
- +26 NEW $ESTACK,$ETRAP
- +27 ;--- Setup the error processing
- +28 DO SETDEFEH^RAERR("RARC")
- +29 ;--- Add the record
- +30 DO UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
- +31 if $GET(DIERR)
- SET RARC=$$DBS^RAERR("RAMSG",-9,70.07,IENS)
- End DoDot:1
- +32 ;
- +33 ;--- Error handling and cleanup
- +34 DO UNLOCKFM^RALOCK(.RALOCK)
- +35 QUIT $SELECT(RARC<0:RARC,1:+RAIENS(1))
- +36 ;
- +37 ;***** UPDATES THE EXAM STATUS
- +38 ;
- +39 ; RACASE Examination identifiers
- +40 ; ^01: IEN of the patient in the file #70 (RADFN)
- +41 ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
- +42 ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
- +43 ;
- +44 ; RASTAT Status identifier(s) in the format of the exam
- +45 ; status descriptor (see the ^RAMAGU06 for details).
- +46 ;
- +47 ; NOTE: Imaging type required to find appropriate
- +48 ; status record is extracted from the TYPE OF
- +49 ; IMAGING field (2) of the sub-file #70.02.
- +50 ;
- +51 ; [RAFLAGS] Flags that control the execution (can be combined):
- +52 ;
- +53 ; F Force the new status even if not all required
- +54 ; conditions (see $$EXMSTREQ^RAMAGU06) are met.
- +55 ;
- +56 ; [REASON] Cancellation reason: either IEN of a record of
- +57 ; the RAD/NUC MED REASON file (#75.2) or a valid
- +58 ; synonym (see SYNONYM field (3) of that file).
- +59 ;
- +60 ; This parameter is required if RASTAT=0.
- +61 ;
- +62 ; The referenced record must have the appropriate
- +63 ; type of reason (see TYPE OF REASON field (2) of
- +64 ; the file #75.2): CANCEL REQUEST (1) or GENERAL
- +65 ; REQUEST (9).
- +66 ;
- +67 ; Return Values:
- +68 ; <0 Error descriptor (see $$ERROR^RAERR)
- +69 ; 0 Exam already has the requested status
- +70 ; >0 IEN of the new record in the sub-file #70.05
- +71 ;
- UPDEXMST(RACASE,RASTAT,RAFLAGS,REASON) ;
- +1 NEW IENS,IENS7003,RAAFTER,RABEFORE,RABUF,RAFDA,RAIENS,RALOCK,RAMSG,RANODE,RARC,TMP
- +2 SET RARC=$$CHKREQ^RAUTL22("RACASE,RASTAT")
- if RARC<0
- QUIT RARC
- +3 SET RARC=$$CHKEXMID^RAMAGU04(RACASE)
- if RARC<0
- QUIT RARC
- +4 SET IENS7003=$$EXAMIENS^RAMAGU04(RACASE)
- +5 SET RAFLAGS=$GET(RAFLAGS)
- +6 ;
- +7 ;=== If status order number is provided, it must be valid
- +8 SET TMP=$PIECE(RASTAT,U,3)
- +9 IF TMP'=""
- IF (+TMP'=TMP)!(TMP<0)!(TMP>9)
- Begin DoDot:1
- +10 SET RARC=$$IPVE^RAERR("RASTAT")
- End DoDot:1
- QUIT RARC
- +11 ;
- +12 ;=== Validate the new exam status and get its descriptor
- +13 IF RASTAT'>0
- Begin DoDot:1
- +14 SET IENS=$PIECE(IENS7003,",",2,99)
- +15 ; TYPE OF IMAGING
- SET TMP=$$GET1^DIQ(70.02,IENS,2,"I",,"RAMSG")
- +16 IF $GET(DIERR)
- SET RASTAT=$$DBS^RAERR("RAMSG",-9,70.02,IENS)
- QUIT
- +17 IF TMP'>0
- SET RASTAT=$$ERROR^RAERR(-19,,70.02,IENS,2)
- QUIT
- +18 SET RASTAT=$$EXMSTINF^RAMAGU06(RASTAT,TMP)
- End DoDot:1
- +19 IF '$TEST
- SET RASTAT=$$EXMSTINF^RAMAGU06(RASTAT)
- +20 if RASTAT<0
- QUIT RASTAT
- +21 ;
- +22 ;=== Check the cancelation reason
- +23 IF $PIECE(RASTAT,U,3)=0
- Begin DoDot:1
- +24 NEW RTYPE
- +25 ;--- Check if it has a value
- +26 IF $GET(REASON)=""
- SET RARC=$$ERROR^RAERR(-8,,"REASON")
- QUIT
- +27 ;--- Find the IEN of the synonym
- +28 SET RARC=$$RARSNIEN^RAMAGU13(REASON,.RTYPE)
- if RARC<0
- QUIT
- +29 ; Pseudo-external value
- SET REASON="`"_(+RARC)
- +30 ;--- Check the type of reason
- +31 SET TMP=+RTYPE
- +32 IF TMP'=1
- IF TMP'=9
- Begin DoDot:2
- +33 SET RARC=$$ERROR^RAERR(-16,,$PIECE(RTYPE,U,2),$PIECE(RASTAT,U,2))
- End DoDot:2
- QUIT
- End DoDot:1
- if RARC<0
- QUIT RARC
- +34 IF '$TEST
- SET REASON=""
- +35 ;
- +36 ;=== Lock the exam
- +37 KILL TMP
- SET TMP(70.03,IENS7003)=""
- +38 SET RARC=$$LOCKFM^RALOCK(.TMP)
- +39 if RARC
- QUIT $$LOCKERR^RAERR(RARC,"examination")
- +40 MERGE RALOCK=TMP
- +41 ;
- +42 Begin DoDot:1
- +43 NEW $ESTACK,$ETRAP,RAOVER,ZTQUEUED
- +44 ; Silence EXAM STATUS input transform (^RASTREQ)
- SET ZTQUEUED=1
- +45 ;=== Setup the error processing
- +46 DO SETDEFEH^RAERR("RARC")
- +47 ;
- +48 ;=== Check if the exam currently has the same status
- +49 SET TMP=$$GET1^DIQ(70.03,IENS7003,3,"I",,"RAMSG")
- +50 IF $GET(DIERR)
- SET RARC=$$DBS^RAERR("RAMSG",-9,70.03,IENS7003)
- QUIT
- +51 if +RASTAT=TMP
- QUIT
- +52 ;
- +53 ;=== Execute the input transform and the ^RASTREQ routine
- +54 IF RAFLAGS'["F"
- Begin DoDot:2
- +55 DO VAL^DIE(70.03,IENS7003,3,,"`"_(+RASTAT),.TMP,,"RAMSG")
- +56 IF TMP="^"
- SET RARC=$$IPVE^RAERR("RASTAT")
- QUIT
- +57 if $GET(RAAFTER)=$PIECE(RASTAT,U,3)
- QUIT
- +58 SET RARC=$$ERROR^RAERR(-31,"RACASE='"_RACASE_"'",$PIECE(RASTAT,U,2))
- End DoDot:2
- if RARC<0
- QUIT
- +59 ;
- +60 ;=== Prepare the data
- +61 SET IENS=IENS7003
- +62 ; EXAM STATUS
- SET RAFDA(70.03,IENS,3)="`"_(+RASTAT)
- +63 ; REASON FOR CANCELLATION
- SET RAFDA(70.03,IENS,3.5)=REASON
- +64 SET IENS="+1,"_IENS7003
- +65 ; STATUS CHANGE DATE/TIME
- SET RAFDA(70.05,IENS,.01)="NOW"
- +66 ; NEW STATUS
- SET RAFDA(70.05,IENS,2)="`"_(+RASTAT)
- +67 ; COMPUTER USER
- SET RAFDA(70.05,IENS,3)="`"_(+DUZ)
- +68 ;
- +69 ;=== Update the record
- +70 DO UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
- +71 if $GET(DIERR)
- SET RARC=$$DBS^RAERR("RAMSG",-9,70.05,IENS)
- End DoDot:1
- +72 ;
- +73 ;=== Error handling and cleanup
- +74 DO UNLOCKFM^RALOCK(.RALOCK)
- +75 QUIT $SELECT(RARC<0:RARC,1:+$GET(RAIENS(1)))