LRAPPF2.m

LRAPPF2 ; IHS/DIR/AAB - ANAT PATH ACC# INDEX 8/13/95 22:01 ;

 ;;5.2;LR;**1002**;JUN 01, 1998

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

 S F=0 F A=0:0 S F=$O(^TMP($J,"S",F)) Q:F=""!(LR("Q"))  S H(4)=F+1700 S:H(4)=1700 H(4)="???" D H Q:LR("Q")  W !,H(4),":",!,"----" D N1

 Q

N1 ;F N=0:0 S N=$O(^TMP($J,"S",F,N)) Q:'N!(LR("Q"))  S W=^(N) D:$Y>(IOSL-6) H1 Q:LR("Q")  W !?6,$J(N,5),?12,$P(W,"^",2),?43,$P(W,"^",3) W:$P(W,"^")'="PATIENT" ?60,$P(W,"^")

 F N=0:0 S N=$O(^TMP($J,"S",F,N)) Q:'N!(LR("Q"))  S W=^(N) D:$Y>(IOSL-6) H1 Q:LR("Q")  W !?6,$J(N,5),?12,$P(W,"^",2),?43,$P(W,"^",3) W:$P(W,"^")'="VA PATIENT" ?60,$P(W,"^")  ;IHS/ANMC/CLS 08/18/96

 Q

H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")

 D F^LRU W !,LRO(68)," ACCESSION INDEX (from: ",LRSTR," to: ",LRLST,")"

 W !,"YEAR",?6,"Acc #",?12,"Entry",?43,"Identifier",?65,"File"

 W !,LR("%") Q

H1 D H Q:LR("Q")  W !,"YEAR:",!,"----" Q

LRAPPF2   ; IHS/DIR/AAB - ANAT PATH ACC# INDEX 8/13/95 22:01 ;

 +1       ;;5.2;LR;**1002**;JUN 01, 1998

 +2       ;;5.2;LAB SERVICE;**72**;Sep 27, 1994

 +3        SET F=0

           FOR A=0:0

               SET F=$ORDER(^TMP($JOB,"S",F))

               IF F=""!(LR("Q"))

                   QUIT 

               SET H(4)=F+1700

               IF H(4)=1700

                   SET H(4)="???"

               DO H

               IF LR("Q")

                   QUIT 

               WRITE !,H(4),":",!,"----"

               DO N1

 +4        QUIT 

N1        ;F N=0:0 S N=$O(^TMP($J,"S",F,N)) Q:'N!(LR("Q"))  S W=^(N) D:$Y>(IOSL-6) H1 Q:LR("Q")  W !?6,$J(N,5),?12,$P(W,"^",2),?43,$P(W,"^",3) W:$P(W,"^")'="PATIENT" ?60,$P(W,"^")

 +1       ;IHS/ANMC/CLS 08/18/96

           FOR N=0:0

               SET N=$ORDER(^TMP($JOB,"S",F,N))

               IF 'N!(LR("Q"))

                   QUIT 

               SET W=^(N)

               IF $Y>(IOSL-6)

                   DO H1

               IF LR("Q")

                   QUIT 

               WRITE !?6,$JUSTIFY(N,5),?12,$PIECE(W,"^",2),?43,$PIECE(W,"^",3)

               IF $PIECE(W,"^")'="VA PATIENT"

                   WRITE ?60,$PIECE(W,"^")

 +2        QUIT 

H          IF $DATA(LR("F"))

               IF IOST?1"C".E

                   DO M^LRU

                   IF LR("Q")

                       QUIT 

 +1        DO F^LRU

           WRITE !,LRO(68)," ACCESSION INDEX (from: ",LRSTR," to: ",LRLST,")"

 +2        WRITE !,"YEAR",?6,"Acc #",?12,"Entry",?43,"Identifier",?65,"File"

 +3        WRITE !,LR("%")

           QUIT 

H1         DO H

           IF LR("Q")

               QUIT 

           WRITE !,"YEAR:",!,"----"

           QUIT