LRAPPF2.m

LRAPPF2 ;AVAMC/REG - ANAT PATH ACC# INDEX ;8/13/95  22:01 ;

 ;;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,"^")

 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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRAPPF2   660     printed  Apr 09, 2024@21:14:31                                                                                                                                                                                                      Page 2

LRAPPF2   ;AVAMC/REG - ANAT PATH ACC# INDEX ;8/13/95  22:01 ;

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

 +2        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

 +3        QUIT 

N1         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,"^")'="PATIENT"

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

 +1        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