- 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 Feb 18, 2025@23:11:10 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