RAERRPT.m

RAERRPT ;HIRMFO/GJC-Access erroneous Rad/Nuc Med reports ;10/23/97  12:39

 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998

EN1 ; Beginning entry point

 K ^TMP($J,"RAEX") D SETVARS^RART1

 I $G(RAIMGTY)="" K XQUIT D KILL Q  ; no sign-on imaging loc specified

 S DIC(0)="QEAMZ",DIC("A")="Select Patient: " D ^RADPA G:Y<0 KILL

 S RADFN=+Y,RAPAT=Y(0,0),RAHEAD="**** Patient's Exams ****"

 D ^RAPTLU G:+X'>0 KILL ; user did not select an exam

 S RA74=$P(^TMP($J,"RAEX",X),"^",10) ; ien for file 74

 S ZTDESC="Rad/Nuc Med Erroneous Reports",ZTRTN="START^RAERRPT"

 F I="RA74","RAPAT" S ZTSAVE(I)=""

 D ZIS^RAUTL

 I RAPOP D KILL Q

START ; Start processing data

 S:$D(ZTQUEUED) ZTREQ="@"

 U IO S (RAIEN,RAXIT)=0

 S RAHD="*** Uncorrected Reports for: "_RAPAT_" ***"

 S $P(RALINE,"-",(IOM+1))="",RAPG=0,RADT=$$FMTE^XLFDT(DT,"1D")

 S RAHD1="Run Date: "_RADT D HDH^RAERRPT G:RAXIT KILL

 F  S RAIEN=$O(^RARPT(RA74,"ERR",RAIEN)) Q:RAIEN'>0  D  Q:RAXIT

 . S RAERR(0)=$G(^RARPT(RA74,"ERR",RAIEN,0))

 . W !?3,"Date/Time Uncorrected Report retained: "

 . W $$FMTE^XLFDT($P(RAERR(0),"^"),"1P"),! S RAI=0

 . F  S RAI=$O(^RARPT(RA74,"ERR",RAIEN,"RPT",RAI)) Q:RAI'>0  D  Q:RAXIT

 .. S RAERRPT=$G(^RARPT(RA74,"ERR",RAIEN,"RPT",RAI,0))

 .. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT  D HDH^RAERRPT

 .. Q:RAXIT  W !,RAERRPT

 .. Q

 . Q

 W ! D ^%ZISC,KILL

 Q

HDH ; Header

 W:$Y @IOF S RAPG=RAPG+1 W !,$$CJ^XLFSTR(RAHD,IOM)

 W !,RAHD1,?$S(IOM=132:121,1:68),"Page: ",RAPG,!,RALINE

 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1

 Q

KILL ; Reset, Kill & quit

 D HOME^%ZIS

 K %W,%X,%XX,%Y,%YY,C,DIC,DIPGM,I,RA74,RACN,RACNI,RADATE,RADFN,RADT

 K RADTE,RADTI,RAERR,RAERRPT,RAHD,RAHD1,RAHEAD,RAI,RAIEN,RALINE,RANME

 K RAPAT,RAPG,RAPOP,RAPRC,RARPT,RASSN,RAST,RAXIT,X,Y,Z

 K POP,RAMES,ZTDESC,ZTRTN,ZTSAVE,DUOUT

 Q

RAERRPT   ;HIRMFO/GJC-Access erroneous Rad/Nuc Med reports ;10/23/97  12:39

 +1       ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998

EN1       ; Beginning entry point

 +1        KILL ^TMP($JOB,"RAEX")

           DO SETVARS^RART1

 +2       ; no sign-on imaging loc specified

           IF $GET(RAIMGTY)=""

               KILL XQUIT

               DO KILL

               QUIT 

 +3        SET DIC(0)="QEAMZ"

           SET DIC("A")="Select Patient: "

           DO ^RADPA

           IF Y<0

               GOTO KILL

 +4        SET RADFN=+Y

           SET RAPAT=Y(0,0)

           SET RAHEAD="**** Patient's Exams ****"

 +5       ; user did not select an exam

           DO ^RAPTLU

           IF +X'>0

               GOTO KILL

 +6       ; ien for file 74

           SET RA74=$PIECE(^TMP($JOB,"RAEX",X),"^",10)

 +7        SET ZTDESC="Rad/Nuc Med Erroneous Reports"

           SET ZTRTN="START^RAERRPT"

 +8        FOR I="RA74","RAPAT"

               SET ZTSAVE(I)=""

 +9        DO ZIS^RAUTL

 +10       IF RAPOP

               DO KILL

               QUIT 

START     ; Start processing data

 +1        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        USE IO

           SET (RAIEN,RAXIT)=0

 +3        SET RAHD="*** Uncorrected Reports for: "_RAPAT_" ***"

 +4        SET $PIECE(RALINE,"-",(IOM+1))=""

           SET RAPG=0

           SET RADT=$$FMTE^XLFDT(DT,"1D")

 +5        SET RAHD1="Run Date: "_RADT

           DO HDH^RAERRPT

           IF RAXIT

               GOTO KILL

 +6        FOR 

               SET RAIEN=$ORDER(^RARPT(RA74,"ERR",RAIEN))

               IF RAIEN'>0

                   QUIT 

               Begin DoDot:1

 +7                SET RAERR(0)=$GET(^RARPT(RA74,"ERR",RAIEN,0))

 +8                WRITE !?3,"Date/Time Uncorrected Report retained: "

 +9                WRITE $$FMTE^XLFDT($PIECE(RAERR(0),"^"),"1P"),!

                   SET RAI=0

 +10               FOR 

                       SET RAI=$ORDER(^RARPT(RA74,"ERR",RAIEN,"RPT",RAI))

                       IF RAI'>0

                           QUIT 

                       Begin DoDot:2

 +11                       SET RAERRPT=$GET(^RARPT(RA74,"ERR",RAIEN,"RPT",RAI,0))

 +12                       IF $Y>(IOSL-4)

                               SET RAXIT=$$EOS^RAUTL5()

                               IF RAXIT

                                   QUIT 

                               DO HDH^RAERRPT

 +13                       IF RAXIT

                               QUIT 

                           WRITE !,RAERRPT

 +14                       QUIT 

                       End DoDot:2

                       IF RAXIT

                           QUIT 

 +15               QUIT 

               End DoDot:1

               IF RAXIT

                   QUIT 

 +16       WRITE !

           DO ^%ZISC

           DO KILL

 +17       QUIT 

HDH       ; Header

 +1        IF $Y

               WRITE @IOF

           SET RAPG=RAPG+1

           WRITE !,$$CJ^XLFSTR(RAHD,IOM)

 +2        WRITE !,RAHD1,?$SELECT(IOM=132:121,1:68),"Page: ",RAPG,!,RALINE

 +3        IF $DATA(ZTQUEUED)

               DO STOPCHK^RAUTL9

               IF $GET(ZTSTOP)=1

                   SET RAXIT=1

 +4        QUIT 

KILL      ; Reset, Kill & quit

 +1        DO HOME^%ZIS

 +2        KILL %W,%X,%XX,%Y,%YY,C,DIC,DIPGM,I,RA74,RACN,RACNI,RADATE,RADFN,RADT

 +3        KILL RADTE,RADTI,RAERR,RAERRPT,RAHD,RAHD1,RAHEAD,RAI,RAIEN,RALINE,RANME

 +4        KILL RAPAT,RAPG,RAPOP,RAPRC,RARPT,RASSN,RAST,RAXIT,X,Y,Z

 +5        KILL POP,RAMES,ZTDESC,ZTRTN,ZTSAVE,DUOUT

 +6        QUIT