BWGRVLP.m

BWGRVLP ; IHS/CMI/LAB - PRINT WH GENERAL REPORT ;15-Feb-2003 21:53;PLS

 ;;2.0;WOMEN'S HEALTH;**6,8**;MAY 16, 1996

START ;EP - Set up header line, dash line

 S BWGRFCNT=0

 S X=0,BWGRHEAD="" F  S X=$O(^BWGRTRPT(BWGRRPT,12,X)) Q:X'=+X  S BWGRHDR=$P(^BWGRI($P(^BWGRTRPT(BWGRRPT,12,X,0),U),0),U,6),BWGRLENG=$P(^BWGRTRPT(BWGRRPT,12,X,0),U,2),BWGRHDR=$E(BWGRHDR,1,BWGRLENG) D

 .S J=$L(BWGRHDR),BWGRHEAD=BWGRHEAD_BWGRHDR,K=$P(^BWGRTRPT(BWGRRPT,12,X,0),U,2)+1 F I=J:1:K S BWGRHEAD=BWGRHEAD_" "

 .Q

 S BWGRDASH="",$P(BWGRDASH,"-",BWGRTCW)="-"

 D COVPAGE^BWGRVLP1 ;print cover page - note: if user ^'s out of cover page, processing continues

PROC ;process printing of report

 I BWGRCTYP="T" G DONE ;--- if displaying only total, that was done in the cover page - go to done

 I BWGRCTYP="C" G DONE ;--- if doing a template, that's already done so goto done

 S BWGRPG=0 I '$D(^XTMP("BWGRVL",BWGRJOB,BWGRBTH)) G DONE

 S (BWGRSRTV,BWGRFRST)="" K BWGRQUIT

 F  S BWGRSRTV=$O(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"DATA HITS",BWGRSRTV)) Q:BWGRSRTV=""!($D(BWGRQUIT))  D V

 G:$D(BWGRQUIT) DONE

 I $Y>(IOSL-4) D HEAD G:$D(BWGRQUIT) DONE

 I $D(BWGRRCNT) W !!!,"Total ",$S(BWGRPTVS="P":"Patients",1:"Procedures"),":  ",BWGRRCNT

 I $G(BWGRPTVS)="R" W !,"Total Patients:  ",BWGRPTCT

DONE ;

 D DONE^BWGRVLP2

 Q

V ;GETS DATA HITS

 S BWGRSCNT=0

 ;get readable sort value

 K BWGRPRNT

 S BWGRSRTR="",BWGRVIEN=$O(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"DATA HITS",BWGRSRTV,0)) I BWGRVIEN]"" S BWGRCRIT=BWGRSORT D

 .I BWGRPTVS="R" S BWGRVREC=^BWPCD(BWGRVIEN,0),DFN=$P(BWGRVREC,U,2) X:$D(^BWGRI(BWGRSORT,3)) ^(3) S BWGRSRTR=BWGRPRNT

 .I BWGRPTVS="P" S DFN=BWGRVIEN X:$D(^BWGRI(BWGRSORT,3)) ^(3) S BWGRSRTR=BWGRPRNT

 I $G(BWGRSPAG)!($D(BWGRFRST)) D HEAD Q:$D(BWGRQUIT)

 K BWGRFRST

 S BWGRVIEN=0 F  S BWGRVIEN=$O(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"DATA HITS",BWGRSRTV,BWGRVIEN)) Q:BWGRVIEN'=+BWGRVIEN!($D(BWGRQUIT))  D

 .I BWGRPTVS="R" S BWGRVREC=^BWPCD(BWGRVIEN,0),DFN=$P(BWGRVREC,U,2) D PRINT Q

 .S DFN=BWGRVIEN D PRINT

 .Q

 Q:$D(BWGRQUIT)

 I $Y>(IOSL-3) D HEAD Q:$D(BWGRQUIT)

 I $G(BWGRSPAG) W !!,"SUB-TOTAL for ",BWGRSORV," ",BWGRSRTR,":  ",BWGRSCNT I BWGRPTVS="R" W "    # of PATIENTS:  ",$S($D(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRTV)):^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRTV),1:0)

 I BWGRCTYP="S",(BWGRPTVS="R") W !,?10,$E(BWGRSRTR,1,30),?45,$J(BWGRSCNT,8)," (PROC)",?60,$S($D(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRTV)):$J(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRTV),8),1:0)," (PATS)"

 I BWGRCTYP="S",(BWGRPTVS="P") W !,?10,$E(BWGRSRTR,1,30),?45,$J(BWGRSCNT,8)

 Q

PRINT ;

 S BWGRSCNT=BWGRSCNT+1 Q:BWGRCTYP="S"

 K ^XTMP("BWGRLINE",$J) S ^XTMP("BWGRLINE",$J,1)=""

 I $Y>(IOSL-5) D HEAD Q:$D(BWGRQUIT)

 S BWGRI=0 F  S BWGRI=$O(^BWGRTRPT(BWGRRPT,12,BWGRI)) Q:BWGRI'=+BWGRI!($D(BWGRQUIT))  S BWGRCRIT=$P(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U) D

 .I '$P(^BWGRI(BWGRCRIT,0),U,8) D SINGLE Q

 .D MULT

 .Q

 S BWGRX=0 F  S BWGRX=$O(^XTMP("BWGRLINE",$J,BWGRX)) Q:BWGRX'=+BWGRX!($D(BWGRQUIT))  D

 .I $Y>(IOSL-4) D HEAD Q:$D(BWGRQUIT)

 .W !,^XTMP("BWGRLINE",$J,BWGRX)

 Q

SINGLE ;process single valued item

 K BWGRPRNT

 S BWGRX=0

 X:$D(^BWGRI(BWGRCRIT,3)) ^(3)

 S BWGRLENG=$P(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2),BWGRPRNT=$E(BWGRPRNT,1,BWGRLENG) D

 .S J=$L(BWGRPRNT),^XTMP("BWGRLINE",$J,1)=^XTMP("BWGRLINE",$J,1)_BWGRPRNT,K=$P(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)+1 F I=J:1:K S ^XTMP("BWGRLINE",$J,1)=^XTMP("BWGRLINE",$J,1)_" "

 .S X=1 F  S X=$O(^XTMP("BWGRLINE",$J,X)) Q:X'=+X  I $L(^XTMP("BWGRLINE",$J,X))<$L(^XTMP("BWGRLINE",$J,1)) S K=$L(^XTMP("BWGRLINE",$J,X))+1,J=$L(^XTMP("BWGRLINE",$J,1)) F I=K:1:J S ^XTMP("BWGRLINE",$J,X)=^XTMP("BWGRLINE",$J,X)_" "

 Q

MULT ;

 K BWGRPRNT,BWGRPRNM,BWGRY S (BWGRX,BWGRPCNT)=0

 X:$D(^BWGRI(BWGRCRIT,3)) ^(3)

 I '$D(BWGRPRNM) S BWGRPRNT="--" D

 .S BWGRLENG=$P(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2),BWGRPRNT=$E(BWGRPRNT,1,BWGRLENG) D

 ..S J=$L(BWGRPRNT),^XTMP("BWGRLINE",$J,1)=^XTMP("BWGRLINE",$J,1)_BWGRPRNT,K=$P(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)+1 F I=J:1:K S ^XTMP("BWGRLINE",$J,1)=^XTMP("BWGRLINE",$J,1)_" "

 S X=0 F  S X=$O(BWGRPRNM(X)) Q:X'=+X  D

 .I X=1 D  Q

 ..S BWGRLENG=$P(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2),BWGRPRNT=$E(BWGRPRNM(1),1,BWGRLENG) D

 ...S J=$L(BWGRPRNT),^XTMP("BWGRLINE",$J,1)=^XTMP("BWGRLINE",$J,1)_BWGRPRNT,K=$P(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)+1 F I=J:1:K S ^XTMP("BWGRLINE",$J,1)=^XTMP("BWGRLINE",$J,1)_" "

 .S BWGRLENG=$P(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2),BWGRPRNT=$E(BWGRPRNM(X),1,BWGRLENG) D

 ..I '$D(^XTMP("BWGRLINE",$J,X)) S ^XTMP("BWGRLINE",$J,X)="",K=$P(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)+1,$P(^XTMP("BWGRLINE",$J,X)," ",($L(^XTMP("BWGRLINE",$J,1))-K))=""

 ..S J=$L(BWGRPRNT),^XTMP("BWGRLINE",$J,X)=^XTMP("BWGRLINE",$J,X)_BWGRPRNT,K=$P(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)+1 F I=J:1:K S ^XTMP("BWGRLINE",$J,X)=^XTMP("BWGRLINE",$J,X)_" "

 S X=1 F  S X=$O(^XTMP("BWGRLINE",$J,X)) Q:X'=+X  I $L(^XTMP("BWGRLINE",$J,X))<$L(^XTMP("BWGRLINE",$J,1)) S K=$L(^XTMP("BWGRLINE",$J,X))+1,J=$L(^XTMP("BWGRLINE",$J,1)) F I=K:1:J S ^XTMP("BWGRLINE",$J,X)=^XTMP("BWGRLINE",$J,X)_" "

 Q

DIQ ;

 K BWGRPRNT,BWGRFILE,BWGRFIEL

 S BWGRFILE=$P($P(^BWGRI(BWGRCRIT,0),U,4),","),BWGRFIEL=$P($P(^(0),U,4),",",2)

 S DIQ(0)="EN",DIQ="BWGRPRNT(",DIC=BWGRFILE,DR=BWGRFIEL D EN^DIQ1 K DIC,DR,DIQ

 I '$D(BWGRPRNT(BWGRFILE,DA,BWGRFIEL,"E")) S BWGRPRNT(BWGRFILE,DA,BWGRFIEL,"E")="--"

 S BWGRPRNT=BWGRPRNT(BWGRFILE,DA,BWGRFIEL,"E")

 Q

HEAD ;ENTRY POINT

 D HEAD^BWGRVLP2

 Q

WRITEF ;write flat file from global

 D WRITEF^BWGRVLP2

 Q

BWGRVLP   ; IHS/CMI/LAB - PRINT WH GENERAL REPORT ;15-Feb-2003 21:53;PLS

 +1       ;;2.0;WOMEN'S HEALTH;**6,8**;MAY 16, 1996

START     ;EP - Set up header line, dash line

 +1        SET BWGRFCNT=0

 +2        SET X=0

           SET BWGRHEAD=""

           FOR 

               SET X=$ORDER(^BWGRTRPT(BWGRRPT,12,X))

               IF X'=+X

                   QUIT 

               SET BWGRHDR=$PIECE(^BWGRI($PIECE(^BWGRTRPT(BWGRRPT,12,X,0),U),0),U,6)

               SET BWGRLENG=$PIECE(^BWGRTRPT(BWGRRPT,12,X,0),U,2)

               SET BWGRHDR=$EXTRACT(BWGRHDR,1,BWGRLENG)

               Begin DoDot:1

 +3                SET J=$LENGTH(BWGRHDR)

                   SET BWGRHEAD=BWGRHEAD_BWGRHDR

                   SET K=$PIECE(^BWGRTRPT(BWGRRPT,12,X,0),U,2)+1

                   FOR I=J:1:K

                       SET BWGRHEAD=BWGRHEAD_" "

 +4                QUIT 

               End DoDot:1

 +5        SET BWGRDASH=""

           SET $PIECE(BWGRDASH,"-",BWGRTCW)="-"

 +6       ;print cover page - note: if user ^'s out of cover page, processing continues

           DO COVPAGE^BWGRVLP1

PROC      ;process printing of report

 +1       ;--- if displaying only total, that was done in the cover page - go to done

           IF BWGRCTYP="T"

               GOTO DONE

 +2       ;--- if doing a template, that's already done so goto done

           IF BWGRCTYP="C"

               GOTO DONE

 +3        SET BWGRPG=0

           IF '$DATA(^XTMP("BWGRVL",BWGRJOB,BWGRBTH))

               GOTO DONE

 +4        SET (BWGRSRTV,BWGRFRST)=""

           KILL BWGRQUIT

 +5        FOR 

               SET BWGRSRTV=$ORDER(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"DATA HITS",BWGRSRTV))

               IF BWGRSRTV=""!($DATA(BWGRQUIT))

                   QUIT 

               DO V

 +6        IF $DATA(BWGRQUIT)

               GOTO DONE

 +7        IF $Y>(IOSL-4)

               DO HEAD

               IF $DATA(BWGRQUIT)

                   GOTO DONE

 +8        IF $DATA(BWGRRCNT)

               WRITE !!!,"Total ",$SELECT(BWGRPTVS="P":"Patients",1:"Procedures"),":  ",BWGRRCNT

 +9        IF $GET(BWGRPTVS)="R"

               WRITE !,"Total Patients:  ",BWGRPTCT

DONE      ;

 +1        DO DONE^BWGRVLP2

 +2        QUIT 

V         ;GETS DATA HITS

 +1        SET BWGRSCNT=0

 +2       ;get readable sort value

 +3        KILL BWGRPRNT

 +4        SET BWGRSRTR=""

           SET BWGRVIEN=$ORDER(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"DATA HITS",BWGRSRTV,0))

           IF BWGRVIEN]""

               SET BWGRCRIT=BWGRSORT

               Begin DoDot:1

 +5                IF BWGRPTVS="R"

                       SET BWGRVREC=^BWPCD(BWGRVIEN,0)

                       SET DFN=$PIECE(BWGRVREC,U,2)

                       IF $DATA(^BWGRI(BWGRSORT,3))

                           XECUTE ^(3)

                       SET BWGRSRTR=BWGRPRNT

 +6                IF BWGRPTVS="P"

                       SET DFN=BWGRVIEN

                       IF $DATA(^BWGRI(BWGRSORT,3))

                           XECUTE ^(3)

                       SET BWGRSRTR=BWGRPRNT

               End DoDot:1

 +7        IF $GET(BWGRSPAG)!($DATA(BWGRFRST))

               DO HEAD

               IF $DATA(BWGRQUIT)

                   QUIT 

 +8        KILL BWGRFRST

 +9        SET BWGRVIEN=0

           FOR 

               SET BWGRVIEN=$ORDER(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"DATA HITS",BWGRSRTV,BWGRVIEN))

               IF BWGRVIEN'=+BWGRVIEN!($DATA(BWGRQUIT))

                   QUIT 

               Begin DoDot:1

 +10               IF BWGRPTVS="R"

                       SET BWGRVREC=^BWPCD(BWGRVIEN,0)

                       SET DFN=$PIECE(BWGRVREC,U,2)

                       DO PRINT

                       QUIT 

 +11               SET DFN=BWGRVIEN

                   DO PRINT

 +12               QUIT 

               End DoDot:1

 +13       IF $DATA(BWGRQUIT)

               QUIT 

 +14       IF $Y>(IOSL-3)

               DO HEAD

               IF $DATA(BWGRQUIT)

                   QUIT 

 +15       IF $GET(BWGRSPAG)

               WRITE !!,"SUB-TOTAL for ",BWGRSORV," ",BWGRSRTR,":  ",BWGRSCNT

               IF BWGRPTVS="R"

                   WRITE "    # of PATIENTS:  ",$SELECT($DATA(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRTV)):^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRTV),1:0)

 +16       IF BWGRCTYP="S"

               IF (BWGRPTVS="R")

                   WRITE !,?10,$EXTRACT(BWGRSRTR,1,30),?45,$JUSTIFY(BWGRSCNT,8)," (PROC)",?60,$SELECT($DATA(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRTV)):$JUSTIFY(^XTMP("BWGRVL",BWGRJOB,BWGRBTH,"SUB PAT COUNT",BWGRSRTV),8),1:0)," (PATS)"

 +17       IF BWGRCTYP="S"

               IF (BWGRPTVS="P")

                   WRITE !,?10,$EXTRACT(BWGRSRTR,1,30),?45,$JUSTIFY(BWGRSCNT,8)

 +18       QUIT 

PRINT     ;

 +1        SET BWGRSCNT=BWGRSCNT+1

           IF BWGRCTYP="S"

               QUIT 

 +2        KILL ^XTMP("BWGRLINE",$JOB)

           SET ^XTMP("BWGRLINE",$JOB,1)=""

 +3        IF $Y>(IOSL-5)

               DO HEAD

               IF $DATA(BWGRQUIT)

                   QUIT 

 +4        SET BWGRI=0

           FOR 

               SET BWGRI=$ORDER(^BWGRTRPT(BWGRRPT,12,BWGRI))

               IF BWGRI'=+BWGRI!($DATA(BWGRQUIT))

                   QUIT 

               SET BWGRCRIT=$PIECE(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U)

               Begin DoDot:1

 +5                IF '$PIECE(^BWGRI(BWGRCRIT,0),U,8)

                       DO SINGLE

                       QUIT 

 +6                DO MULT

 +7                QUIT 

               End DoDot:1

 +8        SET BWGRX=0

           FOR 

               SET BWGRX=$ORDER(^XTMP("BWGRLINE",$JOB,BWGRX))

               IF BWGRX'=+BWGRX!($DATA(BWGRQUIT))

                   QUIT 

               Begin DoDot:1

 +9                IF $Y>(IOSL-4)

                       DO HEAD

                       IF $DATA(BWGRQUIT)

                           QUIT 

 +10               WRITE !,^XTMP("BWGRLINE",$JOB,BWGRX)

               End DoDot:1

 +11       QUIT 

SINGLE    ;process single valued item

 +1        KILL BWGRPRNT

 +2        SET BWGRX=0

 +3        IF $DATA(^BWGRI(BWGRCRIT,3))

               XECUTE ^(3)

 +4        SET BWGRLENG=$PIECE(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)

           SET BWGRPRNT=$EXTRACT(BWGRPRNT,1,BWGRLENG)

           Begin DoDot:1

 +5            SET J=$LENGTH(BWGRPRNT)

               SET ^XTMP("BWGRLINE",$JOB,1)=^XTMP("BWGRLINE",$JOB,1)_BWGRPRNT

               SET K=$PIECE(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)+1

               FOR I=J:1:K

                   SET ^XTMP("BWGRLINE",$JOB,1)=^XTMP("BWGRLINE",$JOB,1)_" "

 +6            SET X=1

               FOR 

                   SET X=$ORDER(^XTMP("BWGRLINE",$JOB,X))

                   IF X'=+X

                       QUIT 

                   IF $LENGTH(^XTMP("BWGRLINE",$JOB,X))<$LENGTH(^XTMP("BWGRLINE",$JOB,1))

                       SET K=$LENGTH(^XTMP("BWGRLINE",$JOB,X))+1

                       SET J=$LENGTH(^XTMP("BWGRLINE",$JOB,1))

                       FOR I=K:1:J

                           SET ^XTMP("BWGRLINE",$JOB,X)=^XTMP("BWGRLINE",$JOB,X)_" "

           End DoDot:1

 +7        QUIT 

MULT      ;

 +1        KILL BWGRPRNT,BWGRPRNM,BWGRY

           SET (BWGRX,BWGRPCNT)=0

 +2        IF $DATA(^BWGRI(BWGRCRIT,3))

               XECUTE ^(3)

 +3        IF '$DATA(BWGRPRNM)

               SET BWGRPRNT="--"

               Begin DoDot:1

 +4                SET BWGRLENG=$PIECE(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)

                   SET BWGRPRNT=$EXTRACT(BWGRPRNT,1,BWGRLENG)

                   Begin DoDot:2

 +5                    SET J=$LENGTH(BWGRPRNT)

                       SET ^XTMP("BWGRLINE",$JOB,1)=^XTMP("BWGRLINE",$JOB,1)_BWGRPRNT

                       SET K=$PIECE(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)+1

                       FOR I=J:1:K

                           SET ^XTMP("BWGRLINE",$JOB,1)=^XTMP("BWGRLINE",$JOB,1)_" "

                   End DoDot:2

               End DoDot:1

 +6        SET X=0

           FOR 

               SET X=$ORDER(BWGRPRNM(X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +7                IF X=1

                       Begin DoDot:2

 +8                        SET BWGRLENG=$PIECE(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)

                           SET BWGRPRNT=$EXTRACT(BWGRPRNM(1),1,BWGRLENG)

                           Begin DoDot:3

 +9                            SET J=$LENGTH(BWGRPRNT)

                               SET ^XTMP("BWGRLINE",$JOB,1)=^XTMP("BWGRLINE",$JOB,1)_BWGRPRNT

                               SET K=$PIECE(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)+1

                               FOR I=J:1:K

                                   SET ^XTMP("BWGRLINE",$JOB,1)=^XTMP("BWGRLINE",$JOB,1)_" "

                           End DoDot:3

                       End DoDot:2

                       QUIT 

 +10               SET BWGRLENG=$PIECE(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)

                   SET BWGRPRNT=$EXTRACT(BWGRPRNM(X),1,BWGRLENG)

                   Begin DoDot:2

 +11                   IF '$DATA(^XTMP("BWGRLINE",$JOB,X))

                           SET ^XTMP("BWGRLINE",$JOB,X)=""

                           SET K=$PIECE(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)+1

                           SET $PIECE(^XTMP("BWGRLINE",$JOB,X)," ",($LENGTH(^XTMP("BWGRLINE",$JOB,1))-K))=""

 +12                   SET J=$LENGTH(BWGRPRNT)

                       SET ^XTMP("BWGRLINE",$JOB,X)=^XTMP("BWGRLINE",$JOB,X)_BWGRPRNT

                       SET K=$PIECE(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)+1

                       FOR I=J:1:K

                           SET ^XTMP("BWGRLINE",$JOB,X)=^XTMP("BWGRLINE",$JOB,X)_" "

                   End DoDot:2

               End DoDot:1

 +13       SET X=1

           FOR 

               SET X=$ORDER(^XTMP("BWGRLINE",$JOB,X))

               IF X'=+X

                   QUIT 

               IF $LENGTH(^XTMP("BWGRLINE",$JOB,X))<$LENGTH(^XTMP("BWGRLINE",$JOB,1))

                   SET K=$LENGTH(^XTMP("BWGRLINE",$JOB,X))+1

                   SET J=$LENGTH(^XTMP("BWGRLINE",$JOB,1))

                   FOR I=K:1:J

                       SET ^XTMP("BWGRLINE",$JOB,X)=^XTMP("BWGRLINE",$JOB,X)_" "

 +14       QUIT 

DIQ       ;

 +1        KILL BWGRPRNT,BWGRFILE,BWGRFIEL

 +2        SET BWGRFILE=$PIECE($PIECE(^BWGRI(BWGRCRIT,0),U,4),",")

           SET BWGRFIEL=$PIECE($PIECE(^(0),U,4),",",2)

 +3        SET DIQ(0)="EN"

           SET DIQ="BWGRPRNT("

           SET DIC=BWGRFILE

           SET DR=BWGRFIEL

           DO EN^DIQ1

           KILL DIC,DR,DIQ

 +4        IF '$DATA(BWGRPRNT(BWGRFILE,DA,BWGRFIEL,"E"))

               SET BWGRPRNT(BWGRFILE,DA,BWGRFIEL,"E")="--"

 +5        SET BWGRPRNT=BWGRPRNT(BWGRFILE,DA,BWGRFIEL,"E")

 +6        QUIT 

HEAD      ;ENTRY POINT

 +1        DO HEAD^BWGRVLP2

 +2        QUIT 

WRITEF    ;write flat file from global

 +1        DO WRITEF^BWGRVLP2

 +2        QUIT