- 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 Feb 19, 2025@00:05:36 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