Routine: LRTOT

LRTOT ; IHS/DIR/FJE - TALLY OF TESTS 2/19/91 13:09 ;

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;;5.2;LAB SERVICE;;Sep 27, 1994

 S U="^",%DT="AE" D ^%DT Q:Y<1  S LRAD=Y K ^TMP($J)

 R !!,"TESTS BY:",!!,?10,"P ==> PRACTITIONER",!,?10,"V ==> VERIFIER",!!,?10,X:DTIME S LRTT=$S($E(X)="P":1,$E(X)="V":2,1:"") G END:LRTT="" W $S(LRTT=1:"RACTITIONER",LRTT=2:"ERIFIER"),!

 G:LRTT=2 TO10

 S LRSN=0

TO1 S LRSN=$O(^LRO(69,LRAD,1,LRSN)) G:LRSN<1 TO5

 S LRDOC=$P(^LRO(69,LRAD,1,LRSN,0),U,6) G:LRDOC="" TO1

 S I=0 F  S I=$O(^LRO(69,LRAD,1,LRSN,2,I)) Q:I<1  S LRTSTS=+^LRO(69,LRAD,1,LRSN,2,I,0) S:'$D(^TMP($J,LRTSTS,LRDOC)) ^TMP($J,LRTSTS,LRDOC)=0 S ^(LRDOC)=^(LRDOC)+1

 G TO1

TO5 W !,"TEST:" S I=0 F  S I=$O(^TMP($J,I)) Q:I<1  W !,$P(^LAB(60,I,0),U) D TO6

 G END

TO6 W !,?5,"BY:" S J=0 F  S J=$O(^TMP($J,I,J)) Q:J<1  S LRDOCT=$S($D(^VA(200,J,0)):$P(^(0),U),1:J) W !,?5,LRDOCT,?30,^TMP($J,I,J)

TO10 S DIC="^LRO(68,",DIC(0)="AEOQZ" D ^DIC G END:Y<1 S LRAA=+Y

 S LRAN=0 F  S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:LRAN<1  Q:+LRAN'=LRAN  D TO11

 W !,"TEST:" S LRTSTS=0 F  S LRTSTS=$O(^TMP($J,LRTSTS)) Q:LRTSTS<1  W !,$S($D(^LAB(60,LRTSTS,0)):$P(^(0),U),1:LRTSTS) D TO12

 K ^TMP($J) G TO10

TO11 S LRTN=0 F  S LRTN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTN)) Q:LRTN<1  S LRINI=$P(^(LRTN,0),U,4),LRTSTS=$P(^(0),U) Q:LRINI=""!(LRTSTS="")  S:'$D(^TMP($J,LRTSTS,LRINI)) ^TMP($J,LRTSTS,LRINI)=0 S ^(LRINI)=^(LRINI)+1

TO12 W !,?5,"BY:" S LRINI=0 F  S LRINI=$O(^TMP($J,LRTSTS,LRINI)) Q:LRINI<1  W !,?5,LRINI,?30,^TMP($J,LRTSTS,LRINI)

END K LRDOCT

LRTOT     ; IHS/DIR/FJE - TALLY OF TESTS 2/19/91 13:09 ;

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4        SET U="^"

           SET %DT="AE"

           DO ^%DT

           IF Y<1

               QUIT

           SET LRAD=Y

           KILL ^TMP($JOB)

 +5        READ !!,"TESTS BY:",!!,?10,"P ==> PRACTITIONER",!,?10,"V ==> VERIFIER",!!,?10,X:DTIME

           SET LRTT=$SELECT($EXTRACT(X)="P":1,$EXTRACT(X)="V":2,1:"")

           IF LRTT=""

               GOTO END

           WRITE $SELECT(LRTT=1:"RACTITIONER",LRTT=2:"ERIFIER"),!

 +6        IF LRTT=2

               GOTO TO10

 +7        SET LRSN=0

TO1        SET LRSN=$ORDER(^LRO(69,LRAD,1,LRSN))

           IF LRSN<1

               GOTO TO5

 +1        SET LRDOC=$PIECE(^LRO(69,LRAD,1,LRSN,0),U,6)

           IF LRDOC=""

               GOTO TO1

 +2        SET I=0

FOR

               SET I=$ORDER(^LRO(69,LRAD,1,LRSN,2,I))

               IF I<1

                   QUIT

               SET LRTSTS=+^LRO(69,LRAD,1,LRSN,2,I,0)

               IF '$DATA(^TMP($JOB,LRTSTS,LRDOC))

                   SET ^TMP($JOB,LRTSTS,LRDOC)=0

               SET ^(LRDOC)=^(LRDOC)+1

 +3        GOTO TO1

TO5        WRITE !,"TEST:"

           SET I=0

FOR

               SET I=$ORDER(^TMP($JOB,I))

               IF I<1

                   QUIT

               WRITE !,$PIECE(^LAB(60,I,0),U)

               DO TO6

 +1        GOTO END

TO6        WRITE !,?5,"BY:"

           SET J=0

FOR

               SET J=$ORDER(^TMP($JOB,I,J))

               IF J<1

                   QUIT

               SET LRDOCT=$SELECT($DATA(^VA(200,J,0)):$PIECE(^(0),U),1:J)

               WRITE !,?5,LRDOCT,?30,^TMP($JOB,I,J)

 +1        QUIT

TO10       SET DIC="^LRO(68,"

           SET DIC(0)="AEOQZ"

           DO ^DIC

           IF Y<1

               GOTO END

           SET LRAA=+Y

 +1        SET LRAN=0

FOR

               SET LRAN=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN))

               IF LRAN<1

                   QUIT

               IF +LRAN'=LRAN

                   QUIT

               DO TO11

 +2        WRITE !,"TEST:"

           SET LRTSTS=0

FOR

               SET LRTSTS=$ORDER(^TMP($JOB,LRTSTS))

               IF LRTSTS<1

                   QUIT

               WRITE !,$SELECT($DATA(^LAB(60,LRTSTS,0)):$PIECE(^(0),U),1:LRTSTS)

               DO TO12

 +3        KILL ^TMP($JOB)

           GOTO TO10

TO11       SET LRTN=0

FOR

               SET LRTN=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTN))

               IF LRTN<1

                   QUIT

               SET LRINI=$PIECE(^(LRTN,0),U,4)

               SET LRTSTS=$PIECE(^(0),U)

               IF LRINI=""!(LRTSTS="")

                   QUIT

               IF '$DATA(^TMP($JOB,LRTSTS,LRINI))

                   SET ^TMP($JOB,LRTSTS,LRINI)=0

               SET ^(LRINI)=^(LRINI)+1

 +1        QUIT

TO12       WRITE !,?5,"BY:"

           SET LRINI=0

FOR

               SET LRINI=$ORDER(^TMP($JOB,LRTSTS,LRINI))

               IF LRINI<1

                   QUIT

               WRITE !,?5,LRINI,?30,^TMP($JOB,LRTSTS,LRINI)

 +1        QUIT

END        KILL LRDOCT

 +1        QUIT

LRTOT.m