- 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 ---[H[J[2J[HLRAPPF2 660 printed Mar 13, 2025@21:12:12 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
