RARTE3 ;HISC/GJC-Create a skeletal report, store in Error Reports multiple ;2/4/97 09:39
;;5.0;Radiology/Nuclear Medicine;**31,56,47**;Mar 16, 1998;Build 21
;Supported IA #10103 NOW^XLFDT
;Supported IA #2053 UPDATE^DIE
; This routine will be accessed when the user unverifies a report.
; At this time, a skeletal copy of the report will be stored off
; in the 'Error Reports' multiple. This will keep track of report
; addendums.
EN1(RADA) ; Create the 'Error Reports' sub-record.
; Input: 'RADA': IEN of the report in file 74.
; Create the record, enter when the report was unverified.
Q:'($D(^TMP($J,"RA AUTOE"))\10)
N RACNT,RAIEN,RANEW,RANOW,X S RANOW=$$NOW^XLFDT()
S RANEW(74.06,"+1,"_RADA_",",.01)=RANOW
D UPDATE^DIE("","RANEW","RAIEN","")
; Error Report date/time field created, now the skeletal report text
S RADA(1)=RADA,RADA=+$G(RAIEN(1)) Q:'RADA ; sub-file ien not created
S RACNT=+$O(^TMP($J,"RA AUTOE",999999999999),-1)
D ZERO K ^TMP($J,"RA AUTOE")
Q
ZERO ; setup the ^TMP($J,"RA AUTOE" global with a zero node
S ^RARPT(RADA(1),"ERR",RADA,"RPT",0)="^^"_RACNT_"^"_RACNT_"^"_(RANOW\1)_"^"
N I S I=0
F S I=$O(^TMP($J,"RA AUTOE",I)) Q:I'>0 D
. S ^RARPT(RADA(1),"ERR",RADA,"RPT",I,0)=$G(^TMP($J,"RA AUTOE",I))
. Q
Q
CHK17 ; called from routine RARTE1
; check 17th piece of exam with same pat/dttm/longcn
; values of RAOK:
; 1 = unknown case no. or unknown case ien, CAN'T DELETE REPORT
; 2 = exm doesn't point to this rpt, CAN DELETE BUT NOT UPGRADE EXM STAT
; 3 = all okay
S RAOK=3
S RADFN=+$P(RA0,"^",2),RADTI=9999999.9999-$P(RA0,"^",3)
;S RACN=$P($P(RA0,"^"),"-",2) ;get from longcase no.'s 2nd part
;P47 replace above line-get case from LAST piece not 2nd (could be SSAN)
S RACN=$P(RA0,"^") S RACN=$P(RACN,"-",$L(RACN,"-"))
I RACN="" D WARN1,PRESS Q
S RACNI=+$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
I 'RACNI D WARN1,PRESS Q
I $P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",17)'=RAIEN D WARN2,PRESS
Q
WARN1 W !!?3,"** Cannot determine internal or external case number. **"
W !!?3,"** You may NOT delete this report. **"
S RAOK=1
Q
WARN2 W !!?3,"** This report refers to an exam that isn't pointing back to this report. **"
S RAOK=2
WARNQ W !!?3,"** You may delete this report if it is indeed the report you don't want. **"
W !?3,"** Or call IRM for help. **"
Q
PRESS R !!?5,"Press RETURN to continue. ",X:DTIME
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARTE3 2433 printed Oct 16, 2024@18:39:54 Page 2
RARTE3 ;HISC/GJC-Create a skeletal report, store in Error Reports multiple ;2/4/97 09:39
+1 ;;5.0;Radiology/Nuclear Medicine;**31,56,47**;Mar 16, 1998;Build 21
+2 ;Supported IA #10103 NOW^XLFDT
+3 ;Supported IA #2053 UPDATE^DIE
+4 ; This routine will be accessed when the user unverifies a report.
+5 ; At this time, a skeletal copy of the report will be stored off
+6 ; in the 'Error Reports' multiple. This will keep track of report
+7 ; addendums.
EN1(RADA) ; Create the 'Error Reports' sub-record.
+1 ; Input: 'RADA': IEN of the report in file 74.
+2 ; Create the record, enter when the report was unverified.
+3 if '($DATA(^TMP($JOB,"RA AUTOE"))\10)
QUIT
+4 NEW RACNT,RAIEN,RANEW,RANOW,X
SET RANOW=$$NOW^XLFDT()
+5 SET RANEW(74.06,"+1,"_RADA_",",.01)=RANOW
+6 DO UPDATE^DIE("","RANEW","RAIEN","")
+7 ; Error Report date/time field created, now the skeletal report text
+8 ; sub-file ien not created
SET RADA(1)=RADA
SET RADA=+$GET(RAIEN(1))
if 'RADA
QUIT
+9 SET RACNT=+$ORDER(^TMP($JOB,"RA AUTOE",999999999999),-1)
+10 DO ZERO
KILL ^TMP($JOB,"RA AUTOE")
+11 QUIT
ZERO ; setup the ^TMP($J,"RA AUTOE" global with a zero node
+1 SET ^RARPT(RADA(1),"ERR",RADA,"RPT",0)="^^"_RACNT_"^"_RACNT_"^"_(RANOW\1)_"^"
+2 NEW I
SET I=0
+3 FOR
SET I=$ORDER(^TMP($JOB,"RA AUTOE",I))
if I'>0
QUIT
Begin DoDot:1
+4 SET ^RARPT(RADA(1),"ERR",RADA,"RPT",I,0)=$GET(^TMP($JOB,"RA AUTOE",I))
+5 QUIT
End DoDot:1
+6 QUIT
CHK17 ; called from routine RARTE1
+1 ; check 17th piece of exam with same pat/dttm/longcn
+2 ; values of RAOK:
+3 ; 1 = unknown case no. or unknown case ien, CAN'T DELETE REPORT
+4 ; 2 = exm doesn't point to this rpt, CAN DELETE BUT NOT UPGRADE EXM STAT
+5 ; 3 = all okay
+6 SET RAOK=3
+7 SET RADFN=+$PIECE(RA0,"^",2)
SET RADTI=9999999.9999-$PIECE(RA0,"^",3)
+8 ;S RACN=$P($P(RA0,"^"),"-",2) ;get from longcase no.'s 2nd part
+9 ;P47 replace above line-get case from LAST piece not 2nd (could be SSAN)
+10 SET RACN=$PIECE(RA0,"^")
SET RACN=$PIECE(RACN,"-",$LENGTH(RACN,"-"))
+11 IF RACN=""
DO WARN1
DO PRESS
QUIT
+12 SET RACNI=+$ORDER(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
+13 IF 'RACNI
DO WARN1
DO PRESS
QUIT
+14 IF $PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",17)'=RAIEN
DO WARN2
DO PRESS
+15 QUIT
WARN1 WRITE !!?3,"** Cannot determine internal or external case number. **"
+1 WRITE !!?3,"** You may NOT delete this report. **"
+2 SET RAOK=1
+3 QUIT
WARN2 WRITE !!?3,"** This report refers to an exam that isn't pointing back to this report. **"
+1 SET RAOK=2
WARNQ WRITE !!?3,"** You may delete this report if it is indeed the report you don't want. **"
+1 WRITE !?3,"** Or call IRM for help. **"
+2 QUIT
PRESS READ !!?5,"Press RETURN to continue. ",X:DTIME
+1 QUIT
