LRDIST3.m

LRDIST3 ;SLC/CJS - DATA DISTRIBUTION ; 2/22/87  1:53 PM ;

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

Q3 ;from LRDIST1

 S Y=^TMP("LR",$J,"X",LRII,1) D DD^LRX W !,Y W:LRSPEC=-1&(^TMP("LR",$J,"X",LRII,3)>0) "  ",$S($D(^LAB(61,^TMP("LR",$J,"X",LRII,3),0)):$P(^(0),U,1),1:"")

 S X=^TMP("LR",$J,"X",LRII,2) W !,?4,@$S(X'=""&$L(LRCHM(.1)):LRCHM(.1),1:"$J(X,LRCW)"),?13

 G:LRCTRL WX

 I ^TMP("LR",$J,"X",LRII,2)<LRLM1 W "*" Q

 I ^TMP("LR",$J,"X",LRII,2)>LRLM2 W ?76,"*" Q

 W ?(^TMP("LR",$J,"X",LRII,2)-LRLM1/LRSTS\1+15),"X"

 Q

WX S LRXF="X" I ^TMP("LR",$J,"X",LRII,2)<LRLM1F S LRFOOT=LRFOOT+1,LRFOOT(LRFOOT)=LRII,LRXF=LRFOOT

 I ^TMP("LR",$J,"X",LRII,2)>LRLM2F S LRFOOT=LRFOOT+1,LRFOOT(LRFOOT)=LRII,LRXF=LRFOOT

 IF (^TMP("LR",$J,"X",LRII,2)-LRLM1/LRSTS\1)<0 W:$L(LRFOOT)=1 " " W LRFOOT

 E  W "  "

 S LRTAB=^TMP("LR",$J,"X",LRII,2)-LRLM1/LRSTS\1+15 F I=15:1:74 W $S(I=LRTAB:LRXF,I=15:".",I=25:"|",I=35:".",I=45:"*",I=55:".",I=65:"|",1:" ") I I=LRTAB,$L(LRXF)'=1 S I=I+$L(LRXF)-1

 W $S(^TMP("LR",$J,"X",LRII,2)=LRLM2:"X",1:".") IF ^TMP("LR",$J,"X",LRII,2)>LRLM2 W ?76,LRFOOT

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRDIST3   1073     printed  Apr 09, 2024@21:16:58                                                                                                                                                                                                     Page 2

LRDIST3   ;SLC/CJS - DATA DISTRIBUTION ; 2/22/87  1:53 PM ;

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

Q3        ;from LRDIST1

 +1        SET Y=^TMP("LR",$JOB,"X",LRII,1)

           DO DD^LRX

           WRITE !,Y

           if LRSPEC=-1&(^TMP("LR",$JOB,"X",LRII,3)>0)

               WRITE "  ",$SELECT($DATA(^LAB(61,^TMP("LR",$JOB,"X",LRII,3),0)):$PIECE(^(0),U,1),1:"")

 +2        SET X=^TMP("LR",$JOB,"X",LRII,2)

           WRITE !,?4,@$SELECT(X'=""&$LENGTH(LRCHM(.1)):LRCHM(.1),1:"$J(X,LRCW)"),?13

 +3        if LRCTRL

               GOTO WX

 +4        IF ^TMP("LR",$JOB,"X",LRII,2)<LRLM1

               WRITE "*"

               QUIT 

 +5        IF ^TMP("LR",$JOB,"X",LRII,2)>LRLM2

               WRITE ?76,"*"

               QUIT 

 +6        WRITE ?(^TMP("LR",$JOB,"X",LRII,2)-LRLM1/LRSTS\1+15),"X"

 +7        QUIT 

WX         SET LRXF="X"

           IF ^TMP("LR",$JOB,"X",LRII,2)<LRLM1F

               SET LRFOOT=LRFOOT+1

               SET LRFOOT(LRFOOT)=LRII

               SET LRXF=LRFOOT

 +1        IF ^TMP("LR",$JOB,"X",LRII,2)>LRLM2F

               SET LRFOOT=LRFOOT+1

               SET LRFOOT(LRFOOT)=LRII

               SET LRXF=LRFOOT

 +2        IF (^TMP("LR",$JOB,"X",LRII,2)-LRLM1/LRSTS\1)<0

               if $LENGTH(LRFOOT)=1

                   WRITE " "

               WRITE LRFOOT

 +3       IF '$TEST

               WRITE "  "

 +4        SET LRTAB=^TMP("LR",$JOB,"X",LRII,2)-LRLM1/LRSTS\1+15

           FOR I=15:1:74

               WRITE $SELECT(I=LRTAB:LRXF,I=15:".",I=25:"|",I=35:".",I=45:"*",I=55:".",I=65:"|",1:" ")

               IF I=LRTAB

                   IF $LENGTH(LRXF)'=1

                       SET I=I+$LENGTH(LRXF)-1

 +5        WRITE $SELECT(^TMP("LR",$JOB,"X",LRII,2)=LRLM2:"X",1:".")

           IF ^TMP("LR",$JOB,"X",LRII,2)>LRLM2

               WRITE ?76,LRFOOT

 +6        QUIT