BWGRVLP2.m

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

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

 ;

DONE ;EP

 I $D(ZTQUEUED),BWGRCTYP="F" G DONE1

 D DONE^BWGRVLU

DONE1 ;

 K ^XTMP("BWGRVL",BWGRJOB,BWGRBT),^XTMP("BWGRFLAT",$J)

 D DEL^BWGRVL

 K BWGRBD,BWGRSD,BWGRED,BWGREDD,BWGRBDD,BWGRRPT,BWGRHEAD,BWGRLINE,BWGRL,BWGRRCNT,BWGRI,BWGRCRIT,BWGRVIEN,BWGRVREC,BWGRJOB,BWGRBT,BWGRBTH,BWGRQUIT,BWGRHDR,BWGRDASH,BWGRLENG,BWGRPCNT,BWGRTCW,BWGRODAT,BWGRPG,AUPNDAYS,AUPNPAT,AUPNDOD,AUPNDOB,AUPNSEX

 K BWGRSORT,BWGRSRT,BWGRSORX,BWGRFILE,BWGRFIEL,BWGRPRNT,BWGRX,BWGRTYPE,BWGRFOUN,D0,J,K,L,BWGRPRNM,BWGRTEST,BWGRSEAT,BWGRLHDR,BWGRFRST

 Q

HEAD ;ENTRY POINT

 I 'BWGRPG G HEAD1

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BWGRQUIT="" Q

HEAD1 ;EP

 I BWGRCTYP="F",$D(ZTQUEUED) Q

 W:$D(IOF) @IOF S BWGRPG=BWGRPG+1

 I $G(BWGRTITL)="" S BWGRTEXT="WOMEN'S HEALTH "_$S(BWGRPTVS="R":"PROCEDURE",1:"PATIENT")_" LISTING",BWGRLENG=$L(BWGRTEXT) W !?((BWGRTCW-BWGRLENG)/2),BWGRTEXT,?(BWGRTCW-8),"Page ",BWGRPG

 I $G(BWGRTITL)]"" S BWGRLENG=$L(BWGRTITL) W !?((BWGRTCW-BWGRLENG)/2),BWGRTITL,?(BWGRTCW-8),"Page ",BWGRPG

 I BWGRTYPE="D" S BWGRLENG=46 S:BWGRTCW<BWGRLENG BWGRLENG=BWGRTCW W !?((BWGRTCW-BWGRLENG)/2),"Procedure Dates:  ",BWGRBDD," and ",BWGREDD,!

 I BWGRTYPE="S" S BWGRLENG=16+$L($P(^DIBT(BWGRSEAT,0),U)) S:BWGRTCW<BWGRLENG BWGRLENG=BWGRTCW  W !?((BWGRTCW-BWGRLENG)/2),"Search Template: ",$P(^DIBT(BWGRSEAT,0),U),!

 I BWGRCTYP="S" S BWGRLENG=$L(BWGRSORV)+23 W !?((BWGRTCW-BWGRLENG)/2),$S(BWGRPTVS="R":"WH PROCEDURE",1:"PATIENT")," SUB-TOTALS BY:  ",BWGRSORV,!

 I $G(BWGRSPAG) S BWGRLENG=$L(BWGRSORV)+$L(BWGRSRTR)+2 S:BWGRTCW<BWGRLENG BWGRLENG=BWGRTCW W !?((BWGRTCW-BWGRLENG)/2),BWGRSORV,":  ",BWGRSRTR,!

 I BWGRHEAD]"" W !,BWGRHEAD,!

 W BWGRDASH,!

 I BWGRCTYP="S" W !,BWGRSORV,":"

 I BWGRCTYP="F",$E(IOST)="C" W !!,"Flat file being created, hold on...",!

 Q

WRITEF ;EP - write out flat file

 S XBGL="XTMP("_$J_",""BWGRFLAT"","

 S XBMED="F",XBFN=BWGRFILE,XBTLE="SAVE OF GEN RET/PGEN RECORDS GENERATED BY -"_$P(^VA(200,DUZ,0),U)

 S XBF=0,XBQ="N",XBFLT=1,XBE=$J

 D ^XBGSAVE

 ;check for error

 K ^XTMP($J,"BWGRFLAT")

 K XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT

 Q

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

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

 +2       ;

DONE      ;EP

 +1        IF $DATA(ZTQUEUED)

               IF BWGRCTYP="F"

                   GOTO DONE1

 +2        DO DONE^BWGRVLU

DONE1     ;

 +1        KILL ^XTMP("BWGRVL",BWGRJOB,BWGRBT),^XTMP("BWGRFLAT",$JOB)

 +2        DO DEL^BWGRVL

 +3        KILL BWGRBD,BWGRSD,BWGRED,BWGREDD,BWGRBDD,BWGRRPT,BWGRHEAD,BWGRLINE,BWGRL,BWGRRCNT,BWGRI,BWGRCRIT,BWGRVIEN,BWGRVREC,BWGRJOB,BWGRBT,BWGRBTH,BWGRQUIT,BWGRHDR,BWGRDASH,BWGRLENG,BWGRPCNT,BWGRTCW,BWGRODAT,BWGRPG,AUPNDAYS,AUPNPAT,AUPNDOD,AUPNDOB,AUPN

SEX

 +4        KILL BWGRSORT,BWGRSRT,BWGRSORX,BWGRFILE,BWGRFIEL,BWGRPRNT,BWGRX,BWGRTYPE,BWGRFOUN,D0,J,K,L,BWGRPRNM,BWGRTEST,BWGRSEAT,BWGRLHDR,BWGRFRST

 +5        QUIT 

HEAD      ;ENTRY POINT

 +1        IF 'BWGRPG

               GOTO HEAD1

 +2        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET BWGRQUIT=""

                       QUIT 

HEAD1     ;EP

 +1        IF BWGRCTYP="F"

               IF $DATA(ZTQUEUED)

                   QUIT 

 +2        IF $DATA(IOF)

               WRITE @IOF

           SET BWGRPG=BWGRPG+1

 +3        IF $GET(BWGRTITL)=""

               SET BWGRTEXT="WOMEN'S HEALTH "_$SELECT(BWGRPTVS="R":"PROCEDURE",1:"PATIENT")_" LISTING"

               SET BWGRLENG=$LENGTH(BWGRTEXT)

               WRITE !?((BWGRTCW-BWGRLENG)/2),BWGRTEXT,?(BWGRTCW-8),"Page ",BWGRPG

 +4        IF $GET(BWGRTITL)]""

               SET BWGRLENG=$LENGTH(BWGRTITL)

               WRITE !?((BWGRTCW-BWGRLENG)/2),BWGRTITL,?(BWGRTCW-8),"Page ",BWGRPG

 +5        IF BWGRTYPE="D"

               SET BWGRLENG=46

               IF BWGRTCW<BWGRLENG

                   SET BWGRLENG=BWGRTCW

               WRITE !?((BWGRTCW-BWGRLENG)/2),"Procedure Dates:  ",BWGRBDD," and ",BWGREDD,!

 +6        IF BWGRTYPE="S"

               SET BWGRLENG=16+$LENGTH($PIECE(^DIBT(BWGRSEAT,0),U))

               IF BWGRTCW<BWGRLENG

                   SET BWGRLENG=BWGRTCW

               WRITE !?((BWGRTCW-BWGRLENG)/2),"Search Template: ",$PIECE(^DIBT(BWGRSEAT,0),U),!

 +7        IF BWGRCTYP="S"

               SET BWGRLENG=$LENGTH(BWGRSORV)+23

               WRITE !?((BWGRTCW-BWGRLENG)/2),$SELECT(BWGRPTVS="R":"WH PROCEDURE",1:"PATIENT")," SUB-TOTALS BY:  ",BWGRSORV,!

 +8        IF $GET(BWGRSPAG)

               SET BWGRLENG=$LENGTH(BWGRSORV)+$LENGTH(BWGRSRTR)+2

               IF BWGRTCW<BWGRLENG

                   SET BWGRLENG=BWGRTCW

               WRITE !?((BWGRTCW-BWGRLENG)/2),BWGRSORV,":  ",BWGRSRTR,!

 +9        IF BWGRHEAD]""

               WRITE !,BWGRHEAD,!

 +10       WRITE BWGRDASH,!

 +11       IF BWGRCTYP="S"

               WRITE !,BWGRSORV,":"

 +12       IF BWGRCTYP="F"

               IF $EXTRACT(IOST)="C"

                   WRITE !!,"Flat file being created, hold on...",!

 +13       QUIT 

WRITEF    ;EP - write out flat file

 +1        SET XBGL="XTMP("_$JOB_",""BWGRFLAT"","

 +2        SET XBMED="F"

           SET XBFN=BWGRFILE

           SET XBTLE="SAVE OF GEN RET/PGEN RECORDS GENERATED BY -"_$PIECE(^VA(200,DUZ,0),U)

 +3        SET XBF=0

           SET XBQ="N"

           SET XBFLT=1

           SET XBE=$JOB

 +4        DO ^XBGSAVE

 +5       ;check for error

 +6        KILL ^XTMP($JOB,"BWGRFLAT")

 +7        KILL XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT

 +8        QUIT