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 ---[H[J[2J[HDVBCLTR 653 printed Nov 22, 2024@16:54:58 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
