| 1 | RARTE3 ;HISC/GJC-Create a skeletal report, store in Error Reports multiple ;2/4/97  09:39 | 
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**31**;Mar 16, 1998 | 
|---|
| 3 | ; This routine will be accessed when the user unverifies a report. | 
|---|
| 4 | ; At this time, a skeletal copy of the report will be stored off | 
|---|
| 5 | ; in the 'Error Reports' multiple.  This will keep track of report | 
|---|
| 6 | ; addendums. | 
|---|
| 7 | EN1(RADA) ; Create the 'Error Reports' sub-record. | 
|---|
| 8 | ; Input: 'RADA': IEN of the report in file 74. | 
|---|
| 9 | ; Create the record, enter when the report was unverified. | 
|---|
| 10 | Q:'($D(^TMP($J,"RA AUTOE"))\10) | 
|---|
| 11 | N RACNT,RAIEN,RANEW,RANOW,X S RANOW=$$NOW^XLFDT() | 
|---|
| 12 | S RANEW(74.06,"+1,"_RADA_",",.01)=RANOW | 
|---|
| 13 | D UPDATE^DIE("","RANEW","RAIEN","") | 
|---|
| 14 | ; Error Report date/time field created, now the skeletal report text | 
|---|
| 15 | S RADA(1)=RADA,RADA=+$G(RAIEN(1)) Q:'RADA  ; sub-file ien not created | 
|---|
| 16 | S RACNT=+$O(^TMP($J,"RA AUTOE",999999999999),-1) | 
|---|
| 17 | D ZERO K ^TMP($J,"RA AUTOE") | 
|---|
| 18 | Q | 
|---|
| 19 | ZERO ; setup the ^TMP($J,"RA AUTOE" global with a zero node | 
|---|
| 20 | S ^RARPT(RADA(1),"ERR",RADA,"RPT",0)="^^"_RACNT_"^"_RACNT_"^"_(RANOW\1)_"^" | 
|---|
| 21 | N I S I=0 | 
|---|
| 22 | F  S I=$O(^TMP($J,"RA AUTOE",I)) Q:I'>0  D | 
|---|
| 23 | . S ^RARPT(RADA(1),"ERR",RADA,"RPT",I,0)=$G(^TMP($J,"RA AUTOE",I)) | 
|---|
| 24 | . Q | 
|---|
| 25 | Q | 
|---|
| 26 | CHK17 ; called from routine RARTE1 | 
|---|
| 27 | ; check 17th piece of exam with same pat/dttm/longcn | 
|---|
| 28 | ; values of RAOK: | 
|---|
| 29 | ; 1 = unknown case no. or unknown case ien, CAN'T DELETE REPORT | 
|---|
| 30 | ; 2 = exm doesn't point to this rpt, CAN DELETE BUT NOT UPGRADE EXM STAT | 
|---|
| 31 | ; 3 = all okay | 
|---|
| 32 | S RAOK=3 | 
|---|
| 33 | S RADFN=+$P(RA0,"^",2),RADTI=9999999.9999-$P(RA0,"^",3),RACN=$P(RA0,"^",4) | 
|---|
| 34 | S:RACN="" RACN=$P($P(RA0,"^"),"-",2) ;get from longcase no.'s 2nd part | 
|---|
| 35 | I RACN="" D WARN1,PRESS Q | 
|---|
| 36 | S RACNI=+$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) | 
|---|
| 37 | I 'RACNI D WARN1,PRESS Q | 
|---|
| 38 | I $P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",17)'=RAIEN D WARN2,PRESS | 
|---|
| 39 | Q | 
|---|
| 40 | WARN1 W !!?3,"** Cannot determine internal or external case number. **" | 
|---|
| 41 | W !!?3,"** You may NOT delete this report. **" | 
|---|
| 42 | S RAOK=1 | 
|---|
| 43 | Q | 
|---|
| 44 | WARN2 W !!?3,"** This report refers to an exam that isn't pointing back to this report. **" | 
|---|
| 45 | S RAOK=2 | 
|---|
| 46 | WARNQ W !!?3,"** You may delete this report if it is indeed the report you don't want. **" | 
|---|
| 47 | W !?3,"** Or call IRM for help. **" | 
|---|
| 48 | Q | 
|---|
| 49 | PRESS R !!?5,"Press RETURN to continue. ",X:DTIME | 
|---|
| 50 | Q | 
|---|