- 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)
- Q
- 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
- Q
- 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)
- Q
- END K LRDOCT
- Q
- 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
