BUD0RP7O ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B ;
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;
;
;
DMRACE1 ;EP - called from taskman
;S BUDPREN=1,BUDSITE=2582,BUDBD=3030101,BUDED=3031231
;S BUDQUIT=0
D HEADER^BUD0RPTP Q:BUDQUIT D T7H^BUD0RP71
W ?29,"|",?39,"HISPANIC/LATINO",?69,"|",!
W ?29,"|",?39,"|",?49,"|",?59,"|",?62,"Black/",?69,"|",! ;,?79,"|",!
W ?29,"|",?39,"|",?41,"Native",?49,"|",?51,"Pacific",?59,"|",?61,"African",?69,"|",! ;,?79,"|",!
W ?29,"|",?32,"Asian",?39,"|",?41,"Hawaiian",?49,"|",?51,"Islander",?59,"|",?61,"American",?69,"|",! ;,?79,"|",!
W ?29,"|",?33,"(a)",?39,"|",?42,"(b1)",?49,"|",?52,"(b2)",?59,"|",?62,"(c)",?69,"|",! ;,?79,"|",!
D LINE^BUD0RP71
I $Y>(IOSL-3) D HEADER^BUD0RPTP Q:BUDQUIT D T7H^BUD0RP71
W ?69,"|",!
W $$CTR("SECTION C: DIABETES BY RACE AND HISPANIC/LATINO IDENTITY",69),?69,"|",! ;,?79,"|",!
D LINE^BUD0RP71
W $$CTR("Patients 18 to 75 diagnosed with Type I or Type II diabetes:",69),?69,"|",!,$$CTR("Most recent test results",69),?69,"|",! ;,?79,"|",!
D LINE^BUD0RP71
W ?2,"9",?5,"Total patients",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",! ;,?79,"|",!
W ?5,"with diabetes",?29,"|",$$C($P($G(BUDSECTC(9)),U)),?39,"|",$$C($P($G(BUDSECTC(9)),U,2)),?49,"|",$$C($P($G(BUDSECTC(9)),U,3)),?59,"|",$$C($P($G(BUDSECTC(9)),U,4)),?69,"|",! ;,?79,"|",!
D LINE1^BUD0RP71
I $Y>(IOSL-3) D HEADER^BUD0RPTP Q:BUDQUIT D T7H^BUD0RP71
W ?1,"10",?5,"Charts sampled or",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",! ;,?79,"|",!
W ?5,"EHR total",?29,"|",$$C($P($G(BUDSECTC(10)),U)),?39,"|",$$C($P($G(BUDSECTC(10)),U,2)),?49,"|",$$C($P($G(BUDSECTC(10)),U,3)),?59,"|",$$C($P($G(BUDSECTC(10)),U,4)),?69,"|",! ;,?79,"|",!
D LINE1^BUD0RP71
I $Y>(IOSL-3) D HEADER^BUD0RPTP Q:BUDQUIT D T7H^BUD0RP71
W ?1,"11",?5,"Patients with ",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",! ;,?79,"|",!
W ?5,"HBA1c < 7%",?29,"|",$$C($P($G(BUDSECTC(11)),U)),?39,"|",$$C($P($G(BUDSECTC(11)),U,2)),?49,"|",$$C($P($G(BUDSECTC(11)),U,3)),?59,"|",$$C($P($G(BUDSECTC(11)),U,4)),?69,"|",! ;,?79,"|",!
D LINE1^BUD0RP71
I $Y>(IOSL-3) D HEADER^BUD0RPTP Q:BUDQUIT D T7H^BUD0RP71
W ?1,"12",?5,"Patients with ",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",! ;,?79,"|",!
W ?5,"7% >= HBA1c <= 9%",?29,"|",$$C($P($G(BUDSECTC(12)),U)),?39,"|",$$C($P($G(BUDSECTC(12)),U,2)),?49,"|",$$C($P($G(BUDSECTC(12)),U,3)),?59,"|",$$C($P($G(BUDSECTC(12)),U,4)),?69,"|",! ;,?79,"|",!
D LINE1^BUD0RP71
I $Y>(IOSL-3) D HEADER^BUD0RPTP Q:BUDQUIT D T7H^BUD0RP71
W ?1,"13",?5,"Patients with ",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",! ;,?79,"|",!
W ?5,"HBA1c > 9% OR No",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",! ;,?79,"|",!
W ?5,"test during year",?29,"|",$$C($P($G(BUDSECTC(13)),U)),?39,"|",$$C($P($G(BUDSECTC(13)),U,2)),?49,"|",$$C($P($G(BUDSECTC(13)),U,3)),?59,"|",$$C($P($G(BUDSECTC(13)),U,4)),?69,"|",! ;,?79,"|",!
D LINE1^BUD0RP71
Q
DMRACE2 ;EP - second page of sections a,b
D HEADER^BUD0RPTP Q:BUDQUIT D T7H1^BUD0RP71
W ?29,"|",?38,"HISPANIC/LATINO",?69,"|",!
W ?29,"|",?31,"American",?39,"|",?49,"|",?52,"More",?59,"|",?60,"Unreport-",?69,"|",! ;?79,"|",!
W ?29,"|",?31,"Indian/",?39,"|",?42,"",?49,"|",?52,"than",?59,"|",?60,"ed/",?69,"|",! ;?79,"|",!
W ?29,"|",?31,"Alaska",?39,"|",?42,"",?49,"|",?52,"one",?59,"|",?60,"Refused",?69,"|",! ;?79,"|",!
W ?29,"|",?31,"Native",?39,"|",?42,"White",?49,"|",?52,"race",?59,"|",?60,"to Report",?69,"|",! ;?72,"Total",?79,"|",!
W ?29,"|",?33,"(d)",?39,"|",?42,"(e)",?49,"|",?52,"(f)",?59,"|",?62,"(g)",?69,"|",! ;?72,"(h)",?79,"|",!
D LINE4^BUD0RP71
I $Y>(IOSL-16) D HEADER^BUD0RPTP Q:BUDQUIT D T7H1^BUD0RP71
W ?69,"|",!
W $$CTR("SECTION C: DIABETES BY RACE AND HISPANIC/LATINO IDENTITY",70),?69,"|",!
D LINE4^BUD0RP71
W $$CTR("Patients 18 to 75 diagnosed with Type I or Type II",70),?69,"|",!
W $$CTR("diabetes: Most recent test results",70),?69,"|",!
D LINE4^BUD0RP71
W ?2,"9",?5,"Total patients",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",! ;?79,"|",!
;W ?5,"18 + with Type I or",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",?79,"|",!
W ?5,"with diabetes",?29,"|",$$C($P($G(BUDSECTC(9)),U,5)),?39,"|",$$C($P($G(BUDSECTC(9)),U,6)),?49,"|",$$C($P($G(BUDSECTC(9)),U,7)),?59,"|",$$C($P($G(BUDSECTC(9)),U,8)),?69,"|",! ;$$C($P($G(BUDSECTC(9)),U,9)),?79,"|",!
D LINE5^BUD0RP71
I $Y>(IOSL-3) D HEADER^BUD0RPTP Q:BUDQUIT D T7H1^BUD0RP71
W ?2,"10",?5,"Charts sampled or",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",! ;?79,"|",!
W ?5,"EHR total",?29,"|",$$C($P($G(BUDSECTC(10)),U,5)),?39,"|",$$C($P($G(BUDSECTC(10)),U,6)),?49,"|",$$C($P($G(BUDSECTC(10)),U,7)),?59,"|",$$C($P($G(BUDSECTC(10)),U,8)),?69,"|",! ;$$C($P($G(BUDSECTC(10)),U,9)),?79,"|",!
D LINE5^BUD0RP71
I $Y>(IOSL-3) D HEADER^BUD0RPTP Q:BUDQUIT D T7H1^BUD0RP71
W ?2,"11",?5,"Patients with",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",! ;?79,"|",!
W ?5,"HBA1c < 7%",?29,"|",$$C($P($G(BUDSECTC(11)),U,5)),?39,"|",$$C($P($G(BUDSECTC(11)),U,6)),?49,"|",$$C($P($G(BUDSECTC(11)),U,7)),?59,"|",$$C($P($G(BUDSECTC(11)),U,8)),?69,"|",! ;$$C($P($G(BUDSECTC(11)),U,9)),?79,"|",!
D LINE5^BUD0RP71
I $Y>(IOSL-3) D HEADER^BUD0RPTP Q:BUDQUIT D T7H1^BUD0RP71
W ?2,"12",?5,"Patients with ",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",! ;?79,"|",!
W ?5,"7% >= HBA1c <= 9%",?29,"|",$$C($P($G(BUDSECTC(12)),U,5)),?39,"|",$$C($P($G(BUDSECTC(12)),U,6)),?49,"|",$$C($P($G(BUDSECTC(12)),U,7)),?59,"|",$$C($P($G(BUDSECTC(12)),U,8)),?69,"|",! ;$$C($P($G(BUDSECTC(12)),U,9)),?79,"|",!
D LINE5^BUD0RP71
I $Y>(IOSL-3) D HEADER^BUD0RPTP Q:BUDQUIT D T7H1^BUD0RP71
W ?2,"13",?5,"Patients with",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",! ;?79,"|",!
W ?5,"HBA1c > 9% OR No",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",! ;?79,"|",!
W ?5,"test during year",?29,"|",$$C($P($G(BUDSECTC(13)),U,5)),?39,"|",$$C($P($G(BUDSECTC(13)),U,6)),?49,"|",$$C($P($G(BUDSECTC(13)),U,7)),?59,"|",$$C($P($G(BUDSECTC(13)),U,8)),?69,"|",! ;$$C($P($G(BUDSECTC(13)),U,9)),?79,"|",!
D LINE5^BUD0RP71
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
PAUSE ;
K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
Q
C(X,Y) ;
I $G(Y)=1,+X=0 Q ""
I $G(Y)=2 Q "********"
S X2=0,X3=8
D COMMA^%DTC
Q X
BUD0RP7O ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B ;
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;
+3 ;
+4 ;
DMRACE1 ;EP - called from taskman
+1 ;S BUDPREN=1,BUDSITE=2582,BUDBD=3030101,BUDED=3031231
+2 ;S BUDQUIT=0
+3 DO HEADER^BUD0RPTP
IF BUDQUIT
QUIT
DO T7H^BUD0RP71
+4 WRITE ?29,"|",?39,"HISPANIC/LATINO",?69,"|",!
+5 ;,?79,"|",!
WRITE ?29,"|",?39,"|",?49,"|",?59,"|",?62,"Black/",?69,"|",!
+6 ;,?79,"|",!
WRITE ?29,"|",?39,"|",?41,"Native",?49,"|",?51,"Pacific",?59,"|",?61,"African",?69,"|",!
+7 ;,?79,"|",!
WRITE ?29,"|",?32,"Asian",?39,"|",?41,"Hawaiian",?49,"|",?51,"Islander",?59,"|",?61,"American",?69,"|",!
+8 ;,?79,"|",!
WRITE ?29,"|",?33,"(a)",?39,"|",?42,"(b1)",?49,"|",?52,"(b2)",?59,"|",?62,"(c)",?69,"|",!
+9 DO LINE^BUD0RP71
+10 IF $Y>(IOSL-3)
DO HEADER^BUD0RPTP
IF BUDQUIT
QUIT
DO T7H^BUD0RP71
+11 WRITE ?69,"|",!
+12 ;,?79,"|",!
WRITE $$CTR("SECTION C: DIABETES BY RACE AND HISPANIC/LATINO IDENTITY",69),?69,"|",!
+13 DO LINE^BUD0RP71
+14 ;,?79,"|",!
WRITE $$CTR("Patients 18 to 75 diagnosed with Type I or Type II diabetes:",69),?69,"|",!,$$CTR("Most recent test results",69),?69,"|",!
+15 DO LINE^BUD0RP71
+16 ;,?79,"|",!
WRITE ?2,"9",?5,"Total patients",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",!
+17 ;,?79,"|",!
WRITE ?5,"with diabetes",?29,"|",$$C($PIECE($GET(BUDSECTC(9)),U)),?39,"|",$$C($PIECE($GET(BUDSECTC(9)),U,2)),?49,"|",$$C($PIECE($GET(BUDSECTC(9)),U,3)),?59,"|",$$C($PIECE($GET(BUDSECTC(9)),U,4)),?69,"|",!
+18 DO LINE1^BUD0RP71
+19 IF $Y>(IOSL-3)
DO HEADER^BUD0RPTP
IF BUDQUIT
QUIT
DO T7H^BUD0RP71
+20 ;,?79,"|",!
WRITE ?1,"10",?5,"Charts sampled or",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",!
+21 ;,?79,"|",!
WRITE ?5,"EHR total",?29,"|",$$C($PIECE($GET(BUDSECTC(10)),U)),?39,"|",$$C($PIECE($GET(BUDSECTC(10)),U,2)),?49,"|",$$C($PIECE($GET(BUDSECTC(10)),U,3)),?59,"|",$$C($PIECE($GET(BUDSECTC(10)),U,4)),?69,"|",!
+22 DO LINE1^BUD0RP71
+23 IF $Y>(IOSL-3)
DO HEADER^BUD0RPTP
IF BUDQUIT
QUIT
DO T7H^BUD0RP71
+24 ;,?79,"|",!
WRITE ?1,"11",?5,"Patients with ",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",!
+25 ;,?79,"|",!
WRITE ?5,"HBA1c < 7%",?29,"|",$$C($PIECE($GET(BUDSECTC(11)),U)),?39,"|",$$C($PIECE($GET(BUDSECTC(11)),U,2)),?49,"|",$$C($PIECE($GET(BUDSECTC(11)),U,3)),?59,"|",$$C($PIECE($GET(BUDSECTC(11)),U,4)),?69,"|",!
+26 DO LINE1^BUD0RP71
+27 IF $Y>(IOSL-3)
DO HEADER^BUD0RPTP
IF BUDQUIT
QUIT
DO T7H^BUD0RP71
+28 ;,?79,"|",!
WRITE ?1,"12",?5,"Patients with ",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",!
+29 ;,?79,"|",!
WRITE ?5,"7% >= HBA1c <= 9%",?29,"|",$$C($PIECE($GET(BUDSECTC(12)),U)),?39,"|",$$C($PIECE($GET(BUDSECTC(12)),U,2)),?49,"|",$$C($PIECE($GET(BUDSECTC(12)),U,3)),?59,"|",$$C($PIECE($GET(BUDSECTC(12)),U,4)),?69,"|",!
+30 DO LINE1^BUD0RP71
+31 IF $Y>(IOSL-3)
DO HEADER^BUD0RPTP
IF BUDQUIT
QUIT
DO T7H^BUD0RP71
+32 ;,?79,"|",!
WRITE ?1,"13",?5,"Patients with ",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",!
+33 ;,?79,"|",!
WRITE ?5,"HBA1c > 9% OR No",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",!
+34 ;,?79,"|",!
WRITE ?5,"test during year",?29,"|",$$C($PIECE($GET(BUDSECTC(13)),U)),?39,"|",$$C($PIECE($GET(BUDSECTC(13)),U,2)),?49,"|",$$C($PIECE($GET(BUDSECTC(13)),U,3)),?59,"|",$$C($PIECE($GET(BUDSECTC(13)),U,4)),?69,"|",!
+35 DO LINE1^BUD0RP71
+36 QUIT
DMRACE2 ;EP - second page of sections a,b
+1 DO HEADER^BUD0RPTP
IF BUDQUIT
QUIT
DO T7H1^BUD0RP71
+2 WRITE ?29,"|",?38,"HISPANIC/LATINO",?69,"|",!
+3 ;?79,"|",!
WRITE ?29,"|",?31,"American",?39,"|",?49,"|",?52,"More",?59,"|",?60,"Unreport-",?69,"|",!
+4 ;?79,"|",!
WRITE ?29,"|",?31,"Indian/",?39,"|",?42,"",?49,"|",?52,"than",?59,"|",?60,"ed/",?69,"|",!
+5 ;?79,"|",!
WRITE ?29,"|",?31,"Alaska",?39,"|",?42,"",?49,"|",?52,"one",?59,"|",?60,"Refused",?69,"|",!
+6 ;?72,"Total",?79,"|",!
WRITE ?29,"|",?31,"Native",?39,"|",?42,"White",?49,"|",?52,"race",?59,"|",?60,"to Report",?69,"|",!
+7 ;?72,"(h)",?79,"|",!
WRITE ?29,"|",?33,"(d)",?39,"|",?42,"(e)",?49,"|",?52,"(f)",?59,"|",?62,"(g)",?69,"|",!
+8 DO LINE4^BUD0RP71
+9 IF $Y>(IOSL-16)
DO HEADER^BUD0RPTP
IF BUDQUIT
QUIT
DO T7H1^BUD0RP71
+10 WRITE ?69,"|",!
+11 WRITE $$CTR("SECTION C: DIABETES BY RACE AND HISPANIC/LATINO IDENTITY",70),?69,"|",!
+12 DO LINE4^BUD0RP71
+13 WRITE $$CTR("Patients 18 to 75 diagnosed with Type I or Type II",70),?69,"|",!
+14 WRITE $$CTR("diabetes: Most recent test results",70),?69,"|",!
+15 DO LINE4^BUD0RP71
+16 ;?79,"|",!
WRITE ?2,"9",?5,"Total patients",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",!
+17 ;W ?5,"18 + with Type I or",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",?79,"|",!
+18 ;$$C($P($G(BUDSECTC(9)),U,9)),?79,"|",!
WRITE ?5,"with diabetes",?29,"|",$$C($PIECE($GET(BUDSECTC(9)),U,5)),?39,"|",$$C($PIECE($GET(BUDSECTC(9)),U,6)),?49,"|",$$C($PIECE($GET(BUDSECTC(9)),U,7)),?59,"|",$$C($PIECE($GET(BUDSECTC(9)),U,8)),?69,"|",!
+19 DO LINE5^BUD0RP71
+20 IF $Y>(IOSL-3)
DO HEADER^BUD0RPTP
IF BUDQUIT
QUIT
DO T7H1^BUD0RP71
+21 ;?79,"|",!
WRITE ?2,"10",?5,"Charts sampled or",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",!
+22 ;$$C($P($G(BUDSECTC(10)),U,9)),?79,"|",!
WRITE ?5,"EHR total",?29,"|",$$C($PIECE($GET(BUDSECTC(10)),U,5)),?39,"|",$$C($PIECE($GET(BUDSECTC(10)),U,6)),?49,"|",$$C($PIECE($GET(BUDSECTC(10)),U,7)),?59,"|",$$C($PIECE($GET(BUDSECTC(10)),U,8)),?69,"|",!
+23 DO LINE5^BUD0RP71
+24 IF $Y>(IOSL-3)
DO HEADER^BUD0RPTP
IF BUDQUIT
QUIT
DO T7H1^BUD0RP71
+25 ;?79,"|",!
WRITE ?2,"11",?5,"Patients with",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",!
+26 ;$$C($P($G(BUDSECTC(11)),U,9)),?79,"|",!
WRITE ?5,"HBA1c < 7%",?29,"|",$$C($PIECE($GET(BUDSECTC(11)),U,5)),?39,"|",$$C($PIECE($GET(BUDSECTC(11)),U,6)),?49,"|",$$C($PIECE($GET(BUDSECTC(11)),U,7)),?59,"|",$$C($PIECE($GET(BUDSECTC(11)),U,8)),?69,"|",!
+27 DO LINE5^BUD0RP71
+28 IF $Y>(IOSL-3)
DO HEADER^BUD0RPTP
IF BUDQUIT
QUIT
DO T7H1^BUD0RP71
+29 ;?79,"|",!
WRITE ?2,"12",?5,"Patients with ",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",!
+30 ;$$C($P($G(BUDSECTC(12)),U,9)),?79,"|",!
WRITE ?5,"7% >= HBA1c <= 9%",?29,"|",$$C($PIECE($GET(BUDSECTC(12)),U,5)),?39,"|",$$C($PIECE($GET(BUDSECTC(12)),U,6)),?49,"|",$$C($PIECE($GET(BUDSECTC(12)),U,7)),?59,"|",$$C($PIECE($GET(BUDSECTC(12)),U,8)),?69,"|",!
+31 DO LINE5^BUD0RP71
+32 IF $Y>(IOSL-3)
DO HEADER^BUD0RPTP
IF BUDQUIT
QUIT
DO T7H1^BUD0RP71
+33 ;?79,"|",!
WRITE ?2,"13",?5,"Patients with",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",!
+34 ;?79,"|",!
WRITE ?5,"HBA1c > 9% OR No",?29,"|",?39,"|",?49,"|",?59,"|",?69,"|",!
+35 ;$$C($P($G(BUDSECTC(13)),U,9)),?79,"|",!
WRITE ?5,"test during year",?29,"|",$$C($PIECE($GET(BUDSECTC(13)),U,5)),?39,"|",$$C($PIECE($GET(BUDSECTC(13)),U,6)),?49,"|",$$C($PIECE($GET(BUDSECTC(13)),U,7)),?59,"|",$$C($PIECE($GET(BUDSECTC(13)),U,8)),?69,"|",!
+36 DO LINE5^BUD0RP71
+37 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
SET DIR("A")="PRESS ENTER"
KILL DA
DO ^DIR
KILL DIR
+2 QUIT
C(X,Y) ;
+1 IF $GET(Y)=1
IF +X=0
QUIT ""
+2 IF $GET(Y)=2
QUIT "********"
+3 SET X2=0
SET X3=8
+4 DO COMMA^%DTC
+5 QUIT X
