BMCRLP ; IHS/PHXAO/TMJ - PRINT REFERRAL REPORT ;
;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
;IHS/ITSC/FCJ ADDED NUMERIC DATE FORMAT PRINT
;4.0 IHS/ITSC/FCJ MODIFIED "R" OPTION, ALL REF WERE NOT PRINTED
;4.0 IHS/ITSC/FCJ ADDED SUFFIX TO PRINT WITH REFERRAL #
;
START ;EP - Set up header line, dash line
S X=0,BMCHEAD="" F S X=$O(^BMCRTMP(BMCRPT,12,X)) Q:X'=+X S BMCHDR=$P(^BMCTSORT($P(^BMCRTMP(BMCRPT,12,X,0),U),0),U,6),BMCLENG=$P(^BMCRTMP(BMCRPT,12,X,0),U,2),BMCHDR=$E(BMCHDR,1,BMCLENG) D
.S J=$L(BMCHDR),BMCHEAD=BMCHEAD_BMCHDR,K=$P(^BMCRTMP(BMCRPT,12,X,0),U,2)+1 F I=J:1:K S BMCHEAD=BMCHEAD_" "
S BMCDASH="",$P(BMCDASH,"-",BMCTCW)="-"
D COVPAGE^BMCRLP1 ;print cover page - note: if user ^'s out of cover page, processing continues
PROC ;process printing of report
S BMCPG=0
I BMCCTYP="T" G DONE ;--- if displaying only total, that was done in the cover page - go to done
I BMCCTYP="N" D N^BMCRLP2 G TOT
I '$D(^XTMP("BMCRL",BMCJOB,BMCBTH)) G DONE
S (BMCSRTV,BMCFRST)="" K BMCQUIT
F S BMCSRTV=$O(^XTMP("BMCRL",BMCJOB,BMCBTH,"DATA HITS",BMCSRTV)) Q:BMCSRTV=""!($D(BMCQUIT)) D V
G:$D(BMCQUIT) DONE
TOT ;
G:$G(BMCCTYP)="R" DONE
I $Y>(IOSL-4) D HEAD G:$D(BMCQUIT) DONE
I $D(BMCRCNT) W !!!,"Total ",$S(BMCPTVS="P":"Patients",1:"Referrals"),": ",BMCRCNT
I $G(BMCPTVS)="R" W !,"Total Patients: ",BMCPTCT
DONE ;
D DONE^BMCRLP2
Q
V ;GETS DATA HITS
S BMCSCNT=0
;get readable sort value
;2.17.05 IHS/ITSC/FCJ MODIFIED NEXT LINE, IT WAS NOT PICKING UP ALL REF
;S BMCSRTR="",BMCREF=$O(^XTMP("BMCRL",BMCJOB,BMCBTH,"DATA HITS",BMCSRTV,0)) I BMCREF]"" S BMCCRIT=BMCSORT D
S BMCSRTR="",BMCREF="" F S BMCREF=$O(^XTMP("BMCRL",BMCJOB,BMCBTH,"DATA HITS",BMCSRTV,BMCREF)) Q:BMCREF'?1N.N I BMCREF]"" S BMCCRIT=BMCSORT D
.I $G(BMCCTYP)="R" D R^BMCRLP2 Q ;2.17.05 IHS/ITSC/FCJ ADDED $G
.I BMCPTVS="R" S BMCRREC=^BMCREF(BMCREF,0),DFN=$P(BMCRREC,U,3) X:$D(^BMCTSORT(BMCSORT,3)) ^(3) S BMCSRTR=BMCPRNT
.I BMCPTVS="P" S DFN=BMCREF X:$D(^BMCTSORT(BMCSORT,3)) ^(3) S BMCSRTR=BMCPRNT
I $G(BMCSPAG)!($D(BMCFRST)) D HEAD Q:$D(BMCQUIT)
K BMCFRST
S BMCREF=0 F S BMCREF=$O(^XTMP("BMCRL",BMCJOB,BMCBTH,"DATA HITS",BMCSRTV,BMCREF)) Q:BMCREF'=+BMCREF!($D(BMCQUIT)) D
.I BMCPTVS="R" S BMCRREC=^BMCREF(BMCREF,0),DFN=$P(BMCRREC,U,3) D PRINT Q
.S DFN=BMCREF D PRINT
Q:$D(BMCQUIT)
I $Y>(IOSL-3) D HEAD Q:$D(BMCQUIT)
W:$G(BMCSPAG) !!,"SUB-TOTAL for ",BMCSORV," ",BMCSRTR,": ",BMCSCNT
W:$G(BMCCTYP)="S" !,?10,$E(BMCSRTR,1,30),?45,$J(BMCSCNT,8) ;2.17.05 IHS/ITSC/FCJ ADDED $G
Q
PRINT ;
S BMCSCNT=BMCSCNT+1 Q:$G(BMCCTYP)="S" ;2.17.05 IHS/ITSC/FCJ ADDED $G
K ^XTMP("BMCLINE",$J) S ^XTMP("BMCLINE",$J,1)=""
I $Y>(IOSL-5) D HEAD Q:$D(BMCQUIT)
S BMCI=0 F S BMCI=$O(^BMCRTMP(BMCRPT,12,BMCI)) Q:BMCI'=+BMCI!($D(BMCQUIT)) S BMCCRIT=$P(^BMCRTMP(BMCRPT,12,BMCI,0),U) D
.I '$P(^BMCTSORT(BMCCRIT,0),U,8) D SINGLE Q
.D MULT
.Q
S BMCX=0 F S BMCX=$O(^XTMP("BMCLINE",$J,BMCX)) Q:BMCX'=+BMCX!($D(BMCQUIT)) D
.I $Y>(IOSL-4) D HEAD Q:$D(BMCQUIT)
.W !,^XTMP("BMCLINE",$J,BMCX)
Q
SINGLE ;process single valued item
K BMCPRNT
S BMCX=0
X:$D(^BMCTSORT(BMCCRIT,3)) ^(3)
S BMCLENG=$P(^BMCRTMP(BMCRPT,12,BMCI,0),U,2),BMCPRNT=$E(BMCPRNT,1,BMCLENG) D
.S J=$L(BMCPRNT),^XTMP("BMCLINE",$J,1)=^XTMP("BMCLINE",$J,1)_BMCPRNT,K=$P(^BMCRTMP(BMCRPT,12,BMCI,0),U,2)+1 F I=J:1:K S ^XTMP("BMCLINE",$J,1)=^XTMP("BMCLINE",$J,1)_" "
.S X=1 F S X=$O(^XTMP("BMCLINE",$J,X)) Q:X'=+X I $L(^XTMP("BMCLINE",$J,X))<$L(^XTMP("BMCLINE",$J,1)) S K=$L(^XTMP("BMCLINE",$J,X))+1,J=$L(^XTMP("BMCLINE",$J,1)) F I=K:1:J S ^XTMP("BMCLINE",$J,X)=^XTMP("BMCLINE",$J,X)_" "
Q
MULT ;
K BMCPRNT,BMCPRNM S (BMCX,BMCPCNT)=0
X:$D(^BMCTSORT(BMCCRIT,3)) ^(3)
I '$D(BMCPRNM) S BMCPRNT="--" D
.S BMCLENG=$P(^BMCRTMP(BMCRPT,12,BMCI,0),U,2),BMCPRNT=$E(BMCPRNT,1,BMCLENG) D
..S J=$L(BMCPRNT),^XTMP("BMCLINE",$J,1)=^XTMP("BMCLINE",$J,1)_BMCPRNT,K=$P(^BMCRTMP(BMCRPT,12,BMCI,0),U,2)+1 F I=J:1:K S ^XTMP("BMCLINE",$J,1)=^XTMP("BMCLINE",$J,1)_" "
S X=0 F S X=$O(BMCPRNM(X)) Q:X'=+X D
.I X=1 D Q
..S BMCLENG=$P(^BMCRTMP(BMCRPT,12,BMCI,0),U,2),BMCPRNT=$E(BMCPRNM(1),1,BMCLENG) D
...S J=$L(BMCPRNT),^XTMP("BMCLINE",$J,1)=^XTMP("BMCLINE",$J,1)_BMCPRNT,K=$P(^BMCRTMP(BMCRPT,12,BMCI,0),U,2)+1 F I=J:1:K S ^XTMP("BMCLINE",$J,1)=^XTMP("BMCLINE",$J,1)_" "
.S BMCLENG=$P(^BMCRTMP(BMCRPT,12,BMCI,0),U,2),BMCPRNT=$E(BMCPRNM(X),1,BMCLENG) D
..I '$D(^XTMP("BMCLINE",$J,X)) S ^XTMP("BMCLINE",$J,X)="",K=$P(^BMCRTMP(BMCRPT,12,BMCI,0),U,2)+1,$P(^XTMP("BMCLINE",$J,X)," ",($L(^XTMP("BMCLINE",$J,1))-K))=""
..S J=$L(BMCPRNT),^XTMP("BMCLINE",$J,X)=^XTMP("BMCLINE",$J,X)_BMCPRNT,K=$P(^BMCRTMP(BMCRPT,12,BMCI,0),U,2)+1 F I=J:1:K S ^XTMP("BMCLINE",$J,X)=^XTMP("BMCLINE",$J,X)_" "
S X=1 F S X=$O(^XTMP("BMCLINE",$J,X)) Q:X'=+X I $L(^XTMP("BMCLINE",$J,X))<$L(^XTMP("BMCLINE",$J,1)) S K=$L(^XTMP("BMCLINE",$J,X))+1,J=$L(^XTMP("BMCLINE",$J,1)) F I=K:1:J S ^XTMP("BMCLINE",$J,X)=^XTMP("BMCLINE",$J,X)_" "
Q
DIQ ;EP FROM REPORT LIST FILE
K BMCPRNT,BMCFILE,BMCFIEL
S BMCFILE=$P($P(^BMCTSORT(BMCCRIT,0),U,4),","),BMCFIEL=$P($P(^(0),U,4),",",2)
S DIQ(0)="ENI",DIQ="BMCPRNT(",DIC=BMCFILE,DR=BMCFIEL D EN^DIQ1 K DIC,DR,DIQ
I BMCFIEL=".02" S BMCPRNT=BMCPRNT(BMCFILE,DA,BMCFIEL,"E")_$P($G(^BMCREF(DA,1)),U),BMCPRNT(BMCFILE,DA,BMCFIEL,"E")=BMCPRNT Q
I '$D(BMCPRNT(BMCFILE,DA,BMCFIEL,"E")) S (BMCPRNT,BMCPRNT(BMCFILE,DA,BMCFIEL,"E"))="--" Q
I $P(^BMCTSORT(BMCCRIT,0),U)="Date of Birth" S Y=BMCPRNT(BMCFILE,DA,BMCFIEL,"I") D DT^BMCOSUT S BMCPRNT=Y Q
I $P(^BMCTSORT(BMCCRIT,0),U,2)="D" S Y=BMCPRNT(BMCFILE,DA,BMCFIEL,"I") D DT1^BMCOSUT S BMCPRNT=Y Q
S BMCPRNT=BMCPRNT(BMCFILE,DA,BMCFIEL,"E")
Q
HEAD ;ENTRY POINT
D HEAD^BMCRLP2
Q
BMCRLP ; IHS/PHXAO/TMJ - PRINT REFERRAL REPORT ;
+1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
+2 ;IHS/ITSC/FCJ ADDED NUMERIC DATE FORMAT PRINT
+3 ;4.0 IHS/ITSC/FCJ MODIFIED "R" OPTION, ALL REF WERE NOT PRINTED
+4 ;4.0 IHS/ITSC/FCJ ADDED SUFFIX TO PRINT WITH REFERRAL #
+5 ;
START ;EP - Set up header line, dash line
+1 SET X=0
SET BMCHEAD=""
FOR
SET X=$ORDER(^BMCRTMP(BMCRPT,12,X))
IF X'=+X
QUIT
SET BMCHDR=$PIECE(^BMCTSORT($PIECE(^BMCRTMP(BMCRPT,12,X,0),U),0),U,6)
SET BMCLENG=$PIECE(^BMCRTMP(BMCRPT,12,X,0),U,2)
SET BMCHDR=$EXTRACT(BMCHDR,1,BMCLENG)
Begin DoDot:1
+2 SET J=$LENGTH(BMCHDR)
SET BMCHEAD=BMCHEAD_BMCHDR
SET K=$PIECE(^BMCRTMP(BMCRPT,12,X,0),U,2)+1
FOR I=J:1:K
SET BMCHEAD=BMCHEAD_" "
End DoDot:1
+3 SET BMCDASH=""
SET $PIECE(BMCDASH,"-",BMCTCW)="-"
+4 ;print cover page - note: if user ^'s out of cover page, processing continues
DO COVPAGE^BMCRLP1
PROC ;process printing of report
+1 SET BMCPG=0
+2 ;--- if displaying only total, that was done in the cover page - go to done
IF BMCCTYP="T"
GOTO DONE
+3 IF BMCCTYP="N"
DO N^BMCRLP2
GOTO TOT
+4 IF '$DATA(^XTMP("BMCRL",BMCJOB,BMCBTH))
GOTO DONE
+5 SET (BMCSRTV,BMCFRST)=""
KILL BMCQUIT
+6 FOR
SET BMCSRTV=$ORDER(^XTMP("BMCRL",BMCJOB,BMCBTH,"DATA HITS",BMCSRTV))
IF BMCSRTV=""!($DATA(BMCQUIT))
QUIT
DO V
+7 IF $DATA(BMCQUIT)
GOTO DONE
TOT ;
+1 IF $GET(BMCCTYP)="R"
GOTO DONE
+2 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BMCQUIT)
GOTO DONE
+3 IF $DATA(BMCRCNT)
WRITE !!!,"Total ",$SELECT(BMCPTVS="P":"Patients",1:"Referrals"),": ",BMCRCNT
+4 IF $GET(BMCPTVS)="R"
WRITE !,"Total Patients: ",BMCPTCT
DONE ;
+1 DO DONE^BMCRLP2
+2 QUIT
V ;GETS DATA HITS
+1 SET BMCSCNT=0
+2 ;get readable sort value
+3 ;2.17.05 IHS/ITSC/FCJ MODIFIED NEXT LINE, IT WAS NOT PICKING UP ALL REF
+4 ;S BMCSRTR="",BMCREF=$O(^XTMP("BMCRL",BMCJOB,BMCBTH,"DATA HITS",BMCSRTV,0)) I BMCREF]"" S BMCCRIT=BMCSORT D
+5 SET BMCSRTR=""
SET BMCREF=""
FOR
SET BMCREF=$ORDER(^XTMP("BMCRL",BMCJOB,BMCBTH,"DATA HITS",BMCSRTV,BMCREF))
IF BMCREF'?1N.N
QUIT
IF BMCREF]""
SET BMCCRIT=BMCSORT
Begin DoDot:1
+6 ;2.17.05 IHS/ITSC/FCJ ADDED $G
IF $GET(BMCCTYP)="R"
DO R^BMCRLP2
QUIT
+7 IF BMCPTVS="R"
SET BMCRREC=^BMCREF(BMCREF,0)
SET DFN=$PIECE(BMCRREC,U,3)
IF $DATA(^BMCTSORT(BMCSORT,3))
XECUTE ^(3)
SET BMCSRTR=BMCPRNT
+8 IF BMCPTVS="P"
SET DFN=BMCREF
IF $DATA(^BMCTSORT(BMCSORT,3))
XECUTE ^(3)
SET BMCSRTR=BMCPRNT
End DoDot:1
+9 IF $GET(BMCSPAG)!($DATA(BMCFRST))
DO HEAD
IF $DATA(BMCQUIT)
QUIT
+10 KILL BMCFRST
+11 SET BMCREF=0
FOR
SET BMCREF=$ORDER(^XTMP("BMCRL",BMCJOB,BMCBTH,"DATA HITS",BMCSRTV,BMCREF))
IF BMCREF'=+BMCREF!($DATA(BMCQUIT))
QUIT
Begin DoDot:1
+12 IF BMCPTVS="R"
SET BMCRREC=^BMCREF(BMCREF,0)
SET DFN=$PIECE(BMCRREC,U,3)
DO PRINT
QUIT
+13 SET DFN=BMCREF
DO PRINT
End DoDot:1
+14 IF $DATA(BMCQUIT)
QUIT
+15 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(BMCQUIT)
QUIT
+16 IF $GET(BMCSPAG)
WRITE !!,"SUB-TOTAL for ",BMCSORV," ",BMCSRTR,": ",BMCSCNT
+17 ;2.17.05 IHS/ITSC/FCJ ADDED $G
IF $GET(BMCCTYP)="S"
WRITE !,?10,$EXTRACT(BMCSRTR,1,30),?45,$JUSTIFY(BMCSCNT,8)
+18 QUIT
PRINT ;
+1 ;2.17.05 IHS/ITSC/FCJ ADDED $G
SET BMCSCNT=BMCSCNT+1
IF $GET(BMCCTYP)="S"
QUIT
+2 KILL ^XTMP("BMCLINE",$JOB)
SET ^XTMP("BMCLINE",$JOB,1)=""
+3 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(BMCQUIT)
QUIT
+4 SET BMCI=0
FOR
SET BMCI=$ORDER(^BMCRTMP(BMCRPT,12,BMCI))
IF BMCI'=+BMCI!($DATA(BMCQUIT))
QUIT
SET BMCCRIT=$PIECE(^BMCRTMP(BMCRPT,12,BMCI,0),U)
Begin DoDot:1
+5 IF '$PIECE(^BMCTSORT(BMCCRIT,0),U,8)
DO SINGLE
QUIT
+6 DO MULT
+7 QUIT
End DoDot:1
+8 SET BMCX=0
FOR
SET BMCX=$ORDER(^XTMP("BMCLINE",$JOB,BMCX))
IF BMCX'=+BMCX!($DATA(BMCQUIT))
QUIT
Begin DoDot:1
+9 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BMCQUIT)
QUIT
+10 WRITE !,^XTMP("BMCLINE",$JOB,BMCX)
End DoDot:1
+11 QUIT
SINGLE ;process single valued item
+1 KILL BMCPRNT
+2 SET BMCX=0
+3 IF $DATA(^BMCTSORT(BMCCRIT,3))
XECUTE ^(3)
+4 SET BMCLENG=$PIECE(^BMCRTMP(BMCRPT,12,BMCI,0),U,2)
SET BMCPRNT=$EXTRACT(BMCPRNT,1,BMCLENG)
Begin DoDot:1
+5 SET J=$LENGTH(BMCPRNT)
SET ^XTMP("BMCLINE",$JOB,1)=^XTMP("BMCLINE",$JOB,1)_BMCPRNT
SET K=$PIECE(^BMCRTMP(BMCRPT,12,BMCI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("BMCLINE",$JOB,1)=^XTMP("BMCLINE",$JOB,1)_" "
+6 SET X=1
FOR
SET X=$ORDER(^XTMP("BMCLINE",$JOB,X))
IF X'=+X
QUIT
IF $LENGTH(^XTMP("BMCLINE",$JOB,X))<$LENGTH(^XTMP("BMCLINE",$JOB,1))
SET K=$LENGTH(^XTMP("BMCLINE",$JOB,X))+1
SET J=$LENGTH(^XTMP("BMCLINE",$JOB,1))
FOR I=K:1:J
SET ^XTMP("BMCLINE",$JOB,X)=^XTMP("BMCLINE",$JOB,X)_" "
End DoDot:1
+7 QUIT
MULT ;
+1 KILL BMCPRNT,BMCPRNM
SET (BMCX,BMCPCNT)=0
+2 IF $DATA(^BMCTSORT(BMCCRIT,3))
XECUTE ^(3)
+3 IF '$DATA(BMCPRNM)
SET BMCPRNT="--"
Begin DoDot:1
+4 SET BMCLENG=$PIECE(^BMCRTMP(BMCRPT,12,BMCI,0),U,2)
SET BMCPRNT=$EXTRACT(BMCPRNT,1,BMCLENG)
Begin DoDot:2
+5 SET J=$LENGTH(BMCPRNT)
SET ^XTMP("BMCLINE",$JOB,1)=^XTMP("BMCLINE",$JOB,1)_BMCPRNT
SET K=$PIECE(^BMCRTMP(BMCRPT,12,BMCI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("BMCLINE",$JOB,1)=^XTMP("BMCLINE",$JOB,1)_" "
End DoDot:2
End DoDot:1
+6 SET X=0
FOR
SET X=$ORDER(BMCPRNM(X))
IF X'=+X
QUIT
Begin DoDot:1
+7 IF X=1
Begin DoDot:2
+8 SET BMCLENG=$PIECE(^BMCRTMP(BMCRPT,12,BMCI,0),U,2)
SET BMCPRNT=$EXTRACT(BMCPRNM(1),1,BMCLENG)
Begin DoDot:3
+9 SET J=$LENGTH(BMCPRNT)
SET ^XTMP("BMCLINE",$JOB,1)=^XTMP("BMCLINE",$JOB,1)_BMCPRNT
SET K=$PIECE(^BMCRTMP(BMCRPT,12,BMCI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("BMCLINE",$JOB,1)=^XTMP("BMCLINE",$JOB,1)_" "
End DoDot:3
End DoDot:2
QUIT
+10 SET BMCLENG=$PIECE(^BMCRTMP(BMCRPT,12,BMCI,0),U,2)
SET BMCPRNT=$EXTRACT(BMCPRNM(X),1,BMCLENG)
Begin DoDot:2
+11 IF '$DATA(^XTMP("BMCLINE",$JOB,X))
SET ^XTMP("BMCLINE",$JOB,X)=""
SET K=$PIECE(^BMCRTMP(BMCRPT,12,BMCI,0),U,2)+1
SET $PIECE(^XTMP("BMCLINE",$JOB,X)," ",($LENGTH(^XTMP("BMCLINE",$JOB,1))-K))=""
+12 SET J=$LENGTH(BMCPRNT)
SET ^XTMP("BMCLINE",$JOB,X)=^XTMP("BMCLINE",$JOB,X)_BMCPRNT
SET K=$PIECE(^BMCRTMP(BMCRPT,12,BMCI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("BMCLINE",$JOB,X)=^XTMP("BMCLINE",$JOB,X)_" "
End DoDot:2
End DoDot:1
+13 SET X=1
FOR
SET X=$ORDER(^XTMP("BMCLINE",$JOB,X))
IF X'=+X
QUIT
IF $LENGTH(^XTMP("BMCLINE",$JOB,X))<$LENGTH(^XTMP("BMCLINE",$JOB,1))
SET K=$LENGTH(^XTMP("BMCLINE",$JOB,X))+1
SET J=$LENGTH(^XTMP("BMCLINE",$JOB,1))
FOR I=K:1:J
SET ^XTMP("BMCLINE",$JOB,X)=^XTMP("BMCLINE",$JOB,X)_" "
+14 QUIT
DIQ ;EP FROM REPORT LIST FILE
+1 KILL BMCPRNT,BMCFILE,BMCFIEL
+2 SET BMCFILE=$PIECE($PIECE(^BMCTSORT(BMCCRIT,0),U,4),",")
SET BMCFIEL=$PIECE($PIECE(^(0),U,4),",",2)
+3 SET DIQ(0)="ENI"
SET DIQ="BMCPRNT("
SET DIC=BMCFILE
SET DR=BMCFIEL
DO EN^DIQ1
KILL DIC,DR,DIQ
+4 IF BMCFIEL=".02"
SET BMCPRNT=BMCPRNT(BMCFILE,DA,BMCFIEL,"E")_$PIECE($GET(^BMCREF(DA,1)),U)
SET BMCPRNT(BMCFILE,DA,BMCFIEL,"E")=BMCPRNT
QUIT
+5 IF '$DATA(BMCPRNT(BMCFILE,DA,BMCFIEL,"E"))
SET (BMCPRNT,BMCPRNT(BMCFILE,DA,BMCFIEL,"E"))="--"
QUIT
+6 IF $PIECE(^BMCTSORT(BMCCRIT,0),U)="Date of Birth"
SET Y=BMCPRNT(BMCFILE,DA,BMCFIEL,"I")
DO DT^BMCOSUT
SET BMCPRNT=Y
QUIT
+7 IF $PIECE(^BMCTSORT(BMCCRIT,0),U,2)="D"
SET Y=BMCPRNT(BMCFILE,DA,BMCFIEL,"I")
DO DT1^BMCOSUT
SET BMCPRNT=Y
QUIT
+8 SET BMCPRNT=BMCPRNT(BMCFILE,DA,BMCFIEL,"E")
+9 QUIT
HEAD ;ENTRY POINT
+1 DO HEAD^BMCRLP2
+2 QUIT
