LRCKF.m

LRCKF ;SLC/RWF - CHECK FILE FOR COHESIVENESS ; 8/30/87  17:19 ;

 ;;5.2;LAB SERVICE;**272,293**;Sep 27, 1994

 D DT^LRX

 W !,"I WILL CHECK ALL LAB FILES TO LOOK FOR INCONSISTENCIES",!!

 D LOG Q:LREND  Q:POP

L D ENT^LRCKF60,ENT^LRCKF62,ENT^LRCKFLA,ENT^LRCKF68,ENT^LRCKF69,ENT^LRACDIAG,ENT^LRCKPTR ;,LRCKF^LRBLJI

 K LRCKW

 W !! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC Q

LOG ;from LRCKF60, LRCKF62, LRCKF68, LRCKF69, LRCKFLA

 S U="^" D DT^LRX S LREND=0

 W !,"DO YOU WANT WARNINGS REPORTED " S %=2 D YN^DICN G LOG:%=0 S LRCKW=(%=1) I %<0 S LREND=1 Q

ASK W !!,"Do you want to only check tests in file 60 that are orderable and/or",!,"printable" S %=1 D YN^DICN Q:%=-1  G:%=0 HELP I %=1 S LRYES=1

 W !,"Where should I send the problem report?",! S %ZIS("A")="REPORT DEVICE: ",%ZIS="QM" D ^%ZIS I POP S LREND=1 Q

 I $D(IO("Q")) K IO("Q") S:'$D(ZTRTN) ZTRTN="DQ^LRCKF" S LREND=1,ZTSAVE("LRCKW")="",ZTDESC="Integrity Report" D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED" K ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE Q

 Q

DQ S:$D(ZTQUEUED) ZTREQ="@" U IO D DT^LRX G L

HELP W !!,"Enter 'YES' if you want me to only check tests that are orderable and/or",!,"printable.  Enter 'NO' if you want me to check all tests in file 60." G ASK

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRCKF   1213     printed  Apr 09, 2024@21:19:45                                                                                                                                                                                                       Page 2

LRCKF     ;SLC/RWF - CHECK FILE FOR COHESIVENESS ; 8/30/87  17:19 ;

 +1       ;;5.2;LAB SERVICE;**272,293**;Sep 27, 1994

 +2        DO DT^LRX

 +3        WRITE !,"I WILL CHECK ALL LAB FILES TO LOOK FOR INCONSISTENCIES",!!

 +4        DO LOG

           if LREND

               QUIT 

           if POP

               QUIT 

L         ;,LRCKF^LRBLJI

           DO ENT^LRCKF60

           DO ENT^LRCKF62

           DO ENT^LRCKFLA

           DO ENT^LRCKF68

           DO ENT^LRCKF69

           DO ENT^LRACDIAG

           DO ENT^LRCKPTR

 +1        KILL LRCKW

 +2        WRITE !!

           if $EXTRACT(IOST,1,2)="P-"

               WRITE @IOF

           DO ^%ZISC

           QUIT 

LOG       ;from LRCKF60, LRCKF62, LRCKF68, LRCKF69, LRCKFLA

 +1        SET U="^"

           DO DT^LRX

           SET LREND=0

 +2        WRITE !,"DO YOU WANT WARNINGS REPORTED "

           SET %=2

           DO YN^DICN

           if %=0

               GOTO LOG

           SET LRCKW=(%=1)

           IF %<0

               SET LREND=1

               QUIT 

ASK        WRITE !!,"Do you want to only check tests in file 60 that are orderable and/or",!,"printable"

           SET %=1

           DO YN^DICN

           if %=-1

               QUIT 

           if %=0

               GOTO HELP

           IF %=1

               SET LRYES=1

 +1        WRITE !,"Where should I send the problem report?",!

           SET %ZIS("A")="REPORT DEVICE: "

           SET %ZIS="QM"

           DO ^%ZIS

           IF POP

               SET LREND=1

               QUIT 

 +2        IF $DATA(IO("Q"))

               KILL IO("Q")

               if '$DATA(ZTRTN)

                   SET ZTRTN="DQ^LRCKF"

               SET LREND=1

               SET ZTSAVE("LRCKW")=""

               SET ZTDESC="Integrity Report"

               DO ^%ZTLOAD

               if $DATA(ZTSK)

                   WRITE !,"REQUEST QUEUED"

               KILL ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE

               QUIT 

 +3        QUIT 

DQ         if $DATA(ZTQUEUED)

               SET ZTREQ="@"

           USE IO

           DO DT^LRX

           GOTO L

HELP       WRITE !!,"Enter 'YES' if you want me to only check tests that are orderable and/or",!,"printable.  Enter 'NO' if you want me to check all tests in file 60."

           GOTO ASK