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

RAMAGU12.m

Go to the documentation of this file.
  1. RAMAGU12 ;HCIOFO/SG - ORDERS/EXAMS API (REPORT UTILS) ; Sep 10, 2020@09:29:33
  1. ;;5.0;Radiology/Nuclear Medicine;**90,174**;Mar 16, 1998;Build 2
  1. ;
  1. Q
  1. ;
  1. ;***** CREATES A REPORT STUB
  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. ; [[.]RADTE] Date of the exam. If this parameter is not defined,
  1. ; the value is loaded from the case record.
  1. ;
  1. ; [[.]RACN] Case number. If this parameter is not defined, the
  1. ; value is loaded from the subfile #70.02.
  1. ;
  1. ; Return values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; >0 Report IEN in the RAD/NUC MED REPORTS file (#74)
  1. ;
  1. RPTSTUB(RACASE,RADTE,RACN) ;
  1. N RABUF,RACNI,RADFN,RADTI,RAIENS,RAMSG,RARPT,TMP
  1. S RADFN=$P(RACASE,U),RADTI=$P(RACASE,U,2),RACNI=$P(RACASE,U,3)
  1. S RAIENS=$$EXAMIENS^RAMAGU04(RACASE)
  1. ;--- Get case properties
  1. S TMP=$S($G(RACN)'>0:".01;17",1:"17")
  1. D GETS^DIQ(70.03,RAIENS,TMP,"I","RABUF","RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
  1. S RARPT=+$G(RABUF(70.03,RAIENS,17,"I"))
  1. Q:RARPT>0 RARPT ;--- Report already exists
  1. S:$G(RACN)'>0 RACN=$G(RABUF(70.03,RAIENS,.01,"I"))
  1. ;--- Get the date if necessary
  1. I $G(RADTE)'>0 D Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.02,TMP)
  1. . S TMP=$P(RAIENS,",",2,4) ; Include trailing comma
  1. . S RADTE=$$GET1^DIQ(70.02,TMP,.01,"I",,"RAMSG")
  1. ;--- Create the stub
  1. D
  1. . N MAGSCN,RAFDA,RASULT,RAX
  1. . D CREATE^RARIC
  1. Q $S($G(RARPT)>0:+RARPT,1:$$ERROR^RAERR(-52))
  1. ;
  1. ;***** RETURNS REPORT STATUS
  1. ;
  1. ; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
  1. ;
  1. ; Return Values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; >0 Internal and external values of the REPORT STATUS
  1. ; field (5) of the RAD/NUC MED REPORTS file (#74)
  1. ; separated by "^".
  1. ;
  1. RPTSTAT(RPTIEN) ;
  1. N IENS,RABUF,RAMSG
  1. S IENS=(+RPTIEN)_","
  1. D GETS^DIQ(74,IENS,"5","EI","RABUF","RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,74,IENS)
  1. Q $G(RABUF(74,IENS,5,"I"))_U_$G(RABUF(74,IENS,5,"E"))
  1. ;
  1. ;***** UPDATES THE REPORT ACTIVITY LOG
  1. ;
  1. ; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
  1. ;
  1. ; ACTION Internal action value (see the TYPE OF ACTION
  1. ; field (2) of the sub-file #74.01).
  1. ;
  1. ; [LOGDT] Internal date value (FileMan) for the LOG DATE
  1. ; field (.01) of the sub-file #74.01. 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 #74.01
  1. ;
  1. UPDRPTAL(RPTIEN,ACTION,LOGDT) ;
  1. N IENS,LOGDT1,RAFDA,RAIENS,RALOCK,RAMSG,RARC,TMP
  1. S RARC=$$CHKREQ^RAUTL22("RPTIEN,ACTION") Q:RARC<0 RARC
  1. S RPTIEN=+RPTIEN
  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,"_RPTIEN_","
  1. S RAFDA(74.01,IENS,.01)=LOGDT1 ; LOG DATE
  1. S RAFDA(74.01,IENS,2)=ACTION ; TYPE OF ACTION
  1. S RAFDA(74.01,IENS,3)="`"_(+DUZ) ; COMPUTER USER
  1. ;
  1. ;--- Lock the ACTIVITY LOG multiple
  1. K TMP S TMP(74.01,","_RPTIEN_",")=""
  1. S RARC=$$LOCKFM^RALOCK(.TMP)
  1. Q:RARC $$LOCKERR^RAERR(RARC,"report 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,74.01,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 REPORT STATUS
  1. ;
  1. ; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
  1. ;
  1. ; STATUS Value for the REPORT STATUS field (5) of file #74
  1. ;
  1. ; [PROBSTAT] Problem statement. If this parameter is defined and
  1. ; not empty (spaces are not counted), then its value
  1. ; is stored into the PROBLEM STATEMENT field (25) of
  1. ; the file #74 and the status is automatically changed
  1. ; to PROBLEM DRAFT.
  1. ;
  1. ; Return Values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Success
  1. ;
  1. UPDRPTST(RPTIEN,STATUS,PROBSTAT) ;
  1. N IENS,RAFDA,RALOCK,RAMSG,RARC,TMP
  1. S RARC=$$CHKREQ^RAUTL22("RPTIEN,STATUS") Q:RARC<0 RARC
  1. S IENS=(+RPTIEN)_","
  1. ;
  1. ;--- Lock the report
  1. K TMP S TMP(74,IENS)=""
  1. S RARC=$$LOCKFM^RALOCK(.TMP)
  1. Q:RARC $$LOCKERR^RAERR(RARC,"report")
  1. M RALOCK=TMP
  1. ;
  1. D
  1. . N $ESTACK,$ETRAP
  1. . ;--- Setup the error processing
  1. . D SETDEFEH^RAERR("RARC")
  1. . ;
  1. . ;--- Check the problem statement
  1. . S TMP=$$TRIM^XLFSTR($G(PROBSTAT))
  1. . S:TMP'="" STATUS="PD"
  1. . D VAL^DIE(74,IENS,25,"F",TMP,.TMP,"RAFDA","RAMSG")
  1. . I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9) Q
  1. . I TMP="^" S RARC=$$IPVE^RAERR("PROBSTAT") Q
  1. . ;
  1. . ;--- Check the new report status
  1. . D VAL^DIE(74,IENS,5,"F",STATUS,.TMP,"RAFDA","RAMSG")
  1. . I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9) Q
  1. . I TMP="^" S RARC=$$IPVE^RAERR("STATUS") Q
  1. . S STATUS=TMP
  1. . ;
  1. . ;--- Check if the report currently has the same status
  1. . S TMP=$$GET1^DIQ(74,IENS,5,"I",,"RAMSG")
  1. . I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9,74,IENS) Q
  1. . I TMP=STATUS K RAFDA(74,IENS,5) Q:$D(RAFDA)<10
  1. . ;
  1. . ;--- Update the record
  1. . D FILE^DIE(,"RAFDA","RAMSG")
  1. . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,74,IENS)
  1. . ;p174 KLM: add link to Women's Health
  1. . I $P(^RARPT(RPTIEN,0),U,5)="EF"!($P(^RARPT(RPTIEN,0),U,5)="V") D CREATE^WVRALINK(RADFN,RADTI,RACNI)
  1. ;
  1. ;--- Error handling and cleanup
  1. D UNLOCKFM^RALOCK(.RALOCK)
  1. Q $S(RARC<0:RARC,1:0)