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

RARTE3.m

Go to the documentation of this file.
  1. 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
  1. ;Supported IA #10103 NOW^XLFDT
  1. ;Supported IA #2053 UPDATE^DIE
  1. ; This routine will be accessed when the user unverifies a report.
  1. ; At this time, a skeletal copy of the report will be stored off
  1. ; in the 'Error Reports' multiple. This will keep track of report
  1. ; addendums.
  1. EN1(RADA) ; Create the 'Error Reports' sub-record.
  1. ; Input: 'RADA': IEN of the report in file 74.
  1. ; Create the record, enter when the report was unverified.
  1. Q:'($D(^TMP($J,"RA AUTOE"))\10)
  1. N RACNT,RAIEN,RANEW,RANOW,X S RANOW=$$NOW^XLFDT()
  1. S RANEW(74.06,"+1,"_RADA_",",.01)=RANOW
  1. D UPDATE^DIE("","RANEW","RAIEN","")
  1. ; Error Report date/time field created, now the skeletal report text
  1. S RADA(1)=RADA,RADA=+$G(RAIEN(1)) Q:'RADA ; sub-file ien not created
  1. S RACNT=+$O(^TMP($J,"RA AUTOE",999999999999),-1)
  1. D ZERO K ^TMP($J,"RA AUTOE")
  1. Q
  1. ZERO ; setup the ^TMP($J,"RA AUTOE" global with a zero node
  1. S ^RARPT(RADA(1),"ERR",RADA,"RPT",0)="^^"_RACNT_"^"_RACNT_"^"_(RANOW\1)_"^"
  1. N I S I=0
  1. F S I=$O(^TMP($J,"RA AUTOE",I)) Q:I'>0 D
  1. . S ^RARPT(RADA(1),"ERR",RADA,"RPT",I,0)=$G(^TMP($J,"RA AUTOE",I))
  1. . Q
  1. Q
  1. CHK17 ; called from routine RARTE1
  1. ; check 17th piece of exam with same pat/dttm/longcn
  1. ; values of RAOK:
  1. ; 1 = unknown case no. or unknown case ien, CAN'T DELETE REPORT
  1. ; 2 = exm doesn't point to this rpt, CAN DELETE BUT NOT UPGRADE EXM STAT
  1. ; 3 = all okay
  1. S RAOK=3
  1. S RADFN=+$P(RA0,"^",2),RADTI=9999999.9999-$P(RA0,"^",3)
  1. ;S RACN=$P($P(RA0,"^"),"-",2) ;get from longcase no.'s 2nd part
  1. ;P47 replace above line-get case from LAST piece not 2nd (could be SSAN)
  1. S RACN=$P(RA0,"^") S RACN=$P(RACN,"-",$L(RACN,"-"))
  1. I RACN="" D WARN1,PRESS Q
  1. S RACNI=+$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
  1. I 'RACNI D WARN1,PRESS Q
  1. I $P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",17)'=RAIEN D WARN2,PRESS
  1. Q
  1. WARN1 W !!?3,"** Cannot determine internal or external case number. **"
  1. W !!?3,"** You may NOT delete this report. **"
  1. S RAOK=1
  1. Q
  1. WARN2 W !!?3,"** This report refers to an exam that isn't pointing back to this report. **"
  1. S RAOK=2
  1. WARNQ W !!?3,"** You may delete this report if it is indeed the report you don't want. **"
  1. W !?3,"** Or call IRM for help. **"
  1. Q
  1. PRESS R !!?5,"Press RETURN to continue. ",X:DTIME
  1. Q