DVBCLTR.m

DVBCLTR ;ALB/GTS-557/THM- PRINT BIG LETTERS ; 5/7/91  11:00 AM

 ;;2.7;AMIE;;Apr 10, 1995

 D ^DVBCLTR2 F DVBCLTR="VAMC","C/P","FEE","EXAM" D X1

Q K ^TMP("DVBCLTR",$J),DVBCLT1,DVBCLT2,DVBCLT3,DVBCLTX,DVBCLTY,DVBCLT

 Q

 ;

X1 S DVBCLTY=$E(DVBCLTR,1,6),DVBCLTX="" F DVBCLT1=1:1:$L(DVBCLTY) I $A(DVBCLTY,DVBCLT1)>32,$D(^TMP("DVBCLTR",$J,$E(DVBCLTY,DVBCLT1))) S DVBCLTX=DVBCLTX_$E(DVBCLTY,DVBCLT1)

 D X2

 Q

 ;

X2 W ! F DVBCLT1=9:-1:1 W ! F DVBCLT3=1:1:$L(DVBCLTX) S X=^TMP("DVBCLTR",$J,$E(DVBCLTX,DVBCLT3)) W "   " F DVBCLT2=1:1:5 W $S($E(X,(DVBCLT2-1*9+DVBCLT1)):"XXX",1:"   ")

 Q

 ;

X3 D ^DVBCLTR2 F DVBCLTR="NOTE","TO","THE","PHYS" D X1

 G Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBCLTR   653     printed  Apr 09, 2024@20:47:39                                                                                                                                                                                                      Page 2

DVBCLTR   ;ALB/GTS-557/THM- PRINT BIG LETTERS ; 5/7/91  11:00 AM

 +1       ;;2.7;AMIE;;Apr 10, 1995

 +2        DO ^DVBCLTR2

           FOR DVBCLTR="VAMC","C/P","FEE","EXAM"

               DO X1

Q          KILL ^TMP("DVBCLTR",$JOB),DVBCLT1,DVBCLT2,DVBCLT3,DVBCLTX,DVBCLTY,DVBCLT

 +1        QUIT 

 +2       ;

X1         SET DVBCLTY=$EXTRACT(DVBCLTR,1,6)

           SET DVBCLTX=""

           FOR DVBCLT1=1:1:$LENGTH(DVBCLTY)

               IF $ASCII(DVBCLTY,DVBCLT1)>32

                   IF $DATA(^TMP("DVBCLTR",$JOB,$EXTRACT(DVBCLTY,DVBCLT1)))

                       SET DVBCLTX=DVBCLTX_$EXTRACT(DVBCLTY,DVBCLT1)

 +1        DO X2

 +2        QUIT 

 +3       ;

X2         WRITE !

           FOR DVBCLT1=9:-1:1

               WRITE !

               FOR DVBCLT3=1:1:$LENGTH(DVBCLTX)

                   SET X=^TMP("DVBCLTR",$JOB,$EXTRACT(DVBCLTX,DVBCLT3))

                   WRITE "   "

                   FOR DVBCLT2=1:1:5

                       WRITE $SELECT($EXTRACT(X,(DVBCLT2-1*9+DVBCLT1)):"XXX",1:"   ")

 +1        QUIT 

 +2       ;

X3         DO ^DVBCLTR2

           FOR DVBCLTR="NOTE","TO","THE","PHYS"

               DO X1

 +1        GOTO Q