RARTE3.m

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

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