RAMAGU12 ;HCIOFO/SG - ORDERS/EXAMS API (REPORT UTILS) ; Sep 10, 2020@09:29:33
;;5.0;Radiology/Nuclear Medicine;**90,174**;Mar 16, 1998;Build 2
;
Q
;
;***** CREATES A REPORT STUB
;
; 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)
;
; [[.]RADTE] Date of the exam. If this parameter is not defined,
; the value is loaded from the case record.
;
; [[.]RACN] Case number. If this parameter is not defined, the
; value is loaded from the subfile #70.02.
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; >0 Report IEN in the RAD/NUC MED REPORTS file (#74)
;
RPTSTUB(RACASE,RADTE,RACN) ;
N RABUF,RACNI,RADFN,RADTI,RAIENS,RAMSG,RARPT,TMP
S RADFN=$P(RACASE,U),RADTI=$P(RACASE,U,2),RACNI=$P(RACASE,U,3)
S RAIENS=$$EXAMIENS^RAMAGU04(RACASE)
;--- Get case properties
S TMP=$S($G(RACN)'>0:".01;17",1:"17")
D GETS^DIQ(70.03,RAIENS,TMP,"I","RABUF","RAMSG")
Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
S RARPT=+$G(RABUF(70.03,RAIENS,17,"I"))
Q:RARPT>0 RARPT ;--- Report already exists
S:$G(RACN)'>0 RACN=$G(RABUF(70.03,RAIENS,.01,"I"))
;--- Get the date if necessary
I $G(RADTE)'>0 D Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.02,TMP)
. S TMP=$P(RAIENS,",",2,4) ; Include trailing comma
. S RADTE=$$GET1^DIQ(70.02,TMP,.01,"I",,"RAMSG")
;--- Create the stub
D
. N MAGSCN,RAFDA,RASULT,RAX
. D CREATE^RARIC
Q $S($G(RARPT)>0:+RARPT,1:$$ERROR^RAERR(-52))
;
;***** RETURNS REPORT STATUS
;
; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
;
; Return Values:
; <0 Error descriptor (see $$ERROR^RAERR)
; >0 Internal and external values of the REPORT STATUS
; field (5) of the RAD/NUC MED REPORTS file (#74)
; separated by "^".
;
RPTSTAT(RPTIEN) ;
N IENS,RABUF,RAMSG
S IENS=(+RPTIEN)_","
D GETS^DIQ(74,IENS,"5","EI","RABUF","RAMSG")
Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,74,IENS)
Q $G(RABUF(74,IENS,5,"I"))_U_$G(RABUF(74,IENS,5,"E"))
;
;***** UPDATES THE REPORT ACTIVITY LOG
;
; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
;
; ACTION Internal action value (see the TYPE OF ACTION
; field (2) of the sub-file #74.01).
;
; [LOGDT] Internal date value (FileMan) for the LOG DATE
; field (.01) of the sub-file #74.01. 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 #74.01
;
UPDRPTAL(RPTIEN,ACTION,LOGDT) ;
N IENS,LOGDT1,RAFDA,RAIENS,RALOCK,RAMSG,RARC,TMP
S RARC=$$CHKREQ^RAUTL22("RPTIEN,ACTION") Q:RARC<0 RARC
S RPTIEN=+RPTIEN
;
;--- 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,"_RPTIEN_","
S RAFDA(74.01,IENS,.01)=LOGDT1 ; LOG DATE
S RAFDA(74.01,IENS,2)=ACTION ; TYPE OF ACTION
S RAFDA(74.01,IENS,3)="`"_(+DUZ) ; COMPUTER USER
;
;--- Lock the ACTIVITY LOG multiple
K TMP S TMP(74.01,","_RPTIEN_",")=""
S RARC=$$LOCKFM^RALOCK(.TMP)
Q:RARC $$LOCKERR^RAERR(RARC,"report 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,74.01,IENS)
;
;--- Error handling and cleanup
D UNLOCKFM^RALOCK(.RALOCK)
Q $S(RARC<0:RARC,1:+RAIENS(1))
;
;***** UPDATES THE REPORT STATUS
;
; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
;
; STATUS Value for the REPORT STATUS field (5) of file #74
;
; [PROBSTAT] Problem statement. If this parameter is defined and
; not empty (spaces are not counted), then its value
; is stored into the PROBLEM STATEMENT field (25) of
; the file #74 and the status is automatically changed
; to PROBLEM DRAFT.
;
; Return Values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Success
;
UPDRPTST(RPTIEN,STATUS,PROBSTAT) ;
N IENS,RAFDA,RALOCK,RAMSG,RARC,TMP
S RARC=$$CHKREQ^RAUTL22("RPTIEN,STATUS") Q:RARC<0 RARC
S IENS=(+RPTIEN)_","
;
;--- Lock the report
K TMP S TMP(74,IENS)=""
S RARC=$$LOCKFM^RALOCK(.TMP)
Q:RARC $$LOCKERR^RAERR(RARC,"report")
M RALOCK=TMP
;
D
. N $ESTACK,$ETRAP
. ;--- Setup the error processing
. D SETDEFEH^RAERR("RARC")
. ;
. ;--- Check the problem statement
. S TMP=$$TRIM^XLFSTR($G(PROBSTAT))
. S:TMP'="" STATUS="PD"
. D VAL^DIE(74,IENS,25,"F",TMP,.TMP,"RAFDA","RAMSG")
. I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9) Q
. I TMP="^" S RARC=$$IPVE^RAERR("PROBSTAT") Q
. ;
. ;--- Check the new report status
. D VAL^DIE(74,IENS,5,"F",STATUS,.TMP,"RAFDA","RAMSG")
. I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9) Q
. I TMP="^" S RARC=$$IPVE^RAERR("STATUS") Q
. S STATUS=TMP
. ;
. ;--- Check if the report currently has the same status
. S TMP=$$GET1^DIQ(74,IENS,5,"I",,"RAMSG")
. I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9,74,IENS) Q
. I TMP=STATUS K RAFDA(74,IENS,5) Q:$D(RAFDA)<10
. ;
. ;--- Update the record
. D FILE^DIE(,"RAFDA","RAMSG")
. S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,74,IENS)
. ;p174 KLM: add link to Women's Health
. I $P(^RARPT(RPTIEN,0),U,5)="EF"!($P(^RARPT(RPTIEN,0),U,5)="V") D CREATE^WVRALINK(RADFN,RADTI,RACNI)
;
;--- Error handling and cleanup
D UNLOCKFM^RALOCK(.RALOCK)
Q $S(RARC<0:RARC,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAGU12 5996 printed Apr 09, 2024@21:36:50 Page 2
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
+2 ;
+3 QUIT
+4 ;
+5 ;***** CREATES A REPORT STUB
+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 ; [[.]RADTE] Date of the exam. If this parameter is not defined,
+13 ; the value is loaded from the case record.
+14 ;
+15 ; [[.]RACN] Case number. If this parameter is not defined, the
+16 ; value is loaded from the subfile #70.02.
+17 ;
+18 ; Return values:
+19 ; <0 Error descriptor (see $$ERROR^RAERR)
+20 ; >0 Report IEN in the RAD/NUC MED REPORTS file (#74)
+21 ;
RPTSTUB(RACASE,RADTE,RACN) ;
+1 NEW RABUF,RACNI,RADFN,RADTI,RAIENS,RAMSG,RARPT,TMP
+2 SET RADFN=$PIECE(RACASE,U)
SET RADTI=$PIECE(RACASE,U,2)
SET RACNI=$PIECE(RACASE,U,3)
+3 SET RAIENS=$$EXAMIENS^RAMAGU04(RACASE)
+4 ;--- Get case properties
+5 SET TMP=$SELECT($GET(RACN)'>0:".01;17",1:"17")
+6 DO GETS^DIQ(70.03,RAIENS,TMP,"I","RABUF","RAMSG")
+7 if $GET(DIERR)
QUIT $$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
+8 SET RARPT=+$GET(RABUF(70.03,RAIENS,17,"I"))
+9 ;--- Report already exists
if RARPT>0
QUIT RARPT
+10 if $GET(RACN)'>0
SET RACN=$GET(RABUF(70.03,RAIENS,.01,"I"))
+11 ;--- Get the date if necessary
+12 IF $GET(RADTE)'>0
Begin DoDot:1
+13 ; Include trailing comma
SET TMP=$PIECE(RAIENS,",",2,4)
+14 SET RADTE=$$GET1^DIQ(70.02,TMP,.01,"I",,"RAMSG")
End DoDot:1
if $GET(DIERR)
QUIT $$DBS^RAERR("RAMSG",-9,70.02,TMP)
+15 ;--- Create the stub
+16 Begin DoDot:1
+17 NEW MAGSCN,RAFDA,RASULT,RAX
+18 DO CREATE^RARIC
End DoDot:1
+19 QUIT $SELECT($GET(RARPT)>0:+RARPT,1:$$ERROR^RAERR(-52))
+20 ;
+21 ;***** RETURNS REPORT STATUS
+22 ;
+23 ; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
+24 ;
+25 ; Return Values:
+26 ; <0 Error descriptor (see $$ERROR^RAERR)
+27 ; >0 Internal and external values of the REPORT STATUS
+28 ; field (5) of the RAD/NUC MED REPORTS file (#74)
+29 ; separated by "^".
+30 ;
RPTSTAT(RPTIEN) ;
+1 NEW IENS,RABUF,RAMSG
+2 SET IENS=(+RPTIEN)_","
+3 DO GETS^DIQ(74,IENS,"5","EI","RABUF","RAMSG")
+4 if $GET(DIERR)
QUIT $$DBS^RAERR("RAMSG",-9,74,IENS)
+5 QUIT $GET(RABUF(74,IENS,5,"I"))_U_$GET(RABUF(74,IENS,5,"E"))
+6 ;
+7 ;***** UPDATES THE REPORT ACTIVITY LOG
+8 ;
+9 ; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
+10 ;
+11 ; ACTION Internal action value (see the TYPE OF ACTION
+12 ; field (2) of the sub-file #74.01).
+13 ;
+14 ; [LOGDT] Internal date value (FileMan) for the LOG DATE
+15 ; field (.01) of the sub-file #74.01. If this
+16 ; parameter is not defined or not greater than 0,
+17 ; then the current date/time is used.
+18 ;
+19 ; Return Values:
+20 ; <0 Error descriptor (see $$ERROR^RAERR)
+21 ; >0 IEN of the new activity sub-record in sub-file #74.01
+22 ;
UPDRPTAL(RPTIEN,ACTION,LOGDT) ;
+1 NEW IENS,LOGDT1,RAFDA,RAIENS,RALOCK,RAMSG,RARC,TMP
+2 SET RARC=$$CHKREQ^RAUTL22("RPTIEN,ACTION")
if RARC<0
QUIT RARC
+3 SET RPTIEN=+RPTIEN
+4 ;
+5 ;--- Check the date/time
+6 IF $GET(LOGDT)>0
Begin DoDot:1
+7 SET TMP=+$EXTRACT(LOGDT,1,12)
SET LOGDT1=$$FMTE^XLFDT(TMP)
+8 if (LOGDT1=TMP)!(LOGDT1="")
SET RARC=$$IPVE^RAERR("LOGDT")
End DoDot:1
if RARC<0
QUIT RARC
+9 IF '$TEST
SET LOGDT1="NOW"
+10 ;
+11 ;--- Prepare the data
+12 SET IENS="+1,"_RPTIEN_","
+13 ; LOG DATE
SET RAFDA(74.01,IENS,.01)=LOGDT1
+14 ; TYPE OF ACTION
SET RAFDA(74.01,IENS,2)=ACTION
+15 ; COMPUTER USER
SET RAFDA(74.01,IENS,3)="`"_(+DUZ)
+16 ;
+17 ;--- Lock the ACTIVITY LOG multiple
+18 KILL TMP
SET TMP(74.01,","_RPTIEN_",")=""
+19 SET RARC=$$LOCKFM^RALOCK(.TMP)
+20 if RARC
QUIT $$LOCKERR^RAERR(RARC,"report activity log")
+21 MERGE RALOCK=TMP
+22 ;
+23 Begin DoDot:1
+24 NEW $ESTACK,$ETRAP
+25 ;--- Setup the error processing
+26 DO SETDEFEH^RAERR("RARC")
+27 ;--- Add the record
+28 DO UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
+29 if $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,74.01,IENS)
End DoDot:1
+30 ;
+31 ;--- Error handling and cleanup
+32 DO UNLOCKFM^RALOCK(.RALOCK)
+33 QUIT $SELECT(RARC<0:RARC,1:+RAIENS(1))
+34 ;
+35 ;***** UPDATES THE REPORT STATUS
+36 ;
+37 ; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
+38 ;
+39 ; STATUS Value for the REPORT STATUS field (5) of file #74
+40 ;
+41 ; [PROBSTAT] Problem statement. If this parameter is defined and
+42 ; not empty (spaces are not counted), then its value
+43 ; is stored into the PROBLEM STATEMENT field (25) of
+44 ; the file #74 and the status is automatically changed
+45 ; to PROBLEM DRAFT.
+46 ;
+47 ; Return Values:
+48 ; <0 Error descriptor (see $$ERROR^RAERR)
+49 ; 0 Success
+50 ;
UPDRPTST(RPTIEN,STATUS,PROBSTAT) ;
+1 NEW IENS,RAFDA,RALOCK,RAMSG,RARC,TMP
+2 SET RARC=$$CHKREQ^RAUTL22("RPTIEN,STATUS")
if RARC<0
QUIT RARC
+3 SET IENS=(+RPTIEN)_","
+4 ;
+5 ;--- Lock the report
+6 KILL TMP
SET TMP(74,IENS)=""
+7 SET RARC=$$LOCKFM^RALOCK(.TMP)
+8 if RARC
QUIT $$LOCKERR^RAERR(RARC,"report")
+9 MERGE RALOCK=TMP
+10 ;
+11 Begin DoDot:1
+12 NEW $ESTACK,$ETRAP
+13 ;--- Setup the error processing
+14 DO SETDEFEH^RAERR("RARC")
+15 ;
+16 ;--- Check the problem statement
+17 SET TMP=$$TRIM^XLFSTR($GET(PROBSTAT))
+18 if TMP'=""
SET STATUS="PD"
+19 DO VAL^DIE(74,IENS,25,"F",TMP,.TMP,"RAFDA","RAMSG")
+20 IF $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9)
QUIT
+21 IF TMP="^"
SET RARC=$$IPVE^RAERR("PROBSTAT")
QUIT
+22 ;
+23 ;--- Check the new report status
+24 DO VAL^DIE(74,IENS,5,"F",STATUS,.TMP,"RAFDA","RAMSG")
+25 IF $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9)
QUIT
+26 IF TMP="^"
SET RARC=$$IPVE^RAERR("STATUS")
QUIT
+27 SET STATUS=TMP
+28 ;
+29 ;--- Check if the report currently has the same status
+30 SET TMP=$$GET1^DIQ(74,IENS,5,"I",,"RAMSG")
+31 IF $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,74,IENS)
QUIT
+32 IF TMP=STATUS
KILL RAFDA(74,IENS,5)
if $DATA(RAFDA)<10
QUIT
+33 ;
+34 ;--- Update the record
+35 DO FILE^DIE(,"RAFDA","RAMSG")
+36 if $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,74,IENS)
+37 ;p174 KLM: add link to Women's Health
+38 IF $PIECE(^RARPT(RPTIEN,0),U,5)="EF"!($PIECE(^RARPT(RPTIEN,0),U,5)="V")
DO CREATE^WVRALINK(RADFN,RADTI,RACNI)
End DoDot:1
+39 ;
+40 ;--- Error handling and cleanup
+41 DO UNLOCKFM^RALOCK(.RALOCK)
+42 QUIT $SELECT(RARC<0:RARC,1:0)
