BWGRVLP1 ; IHS/CMI/LAB - CONT OF BWGRVLP ;15-Feb-2003 21:53;PLS
;;2.0;WOMEN'S HEALTH;**6,8**;MAY 16, 1996
;
;
COVPAGE ;EP
W:$D(IOF) @IOF
W !?20,"WOMENS' HEALTH MANAGEMENT REPORTS ",$S(BWGRPTVS="P":"WH PATIENT",1:"WH PROCEDURE")," ",$S(BWGRCTYP="D":"LISTING",1:"COUNT")
W !?34,"SUMMARY PAGE"
W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U),!
SHOW ;
W !,$S(BWGRPTVS="P":"WH PATIENT",1:"WH PROCEDURE")," Selection Criteria"
W:BWGRTYPE["V" !?6,"Encounter Date range: ",BWGRBDD," to ",BWGREDD
I BWGRTYPE="VP"!(BWGRTYPE="VV")!(BWGRTYPE="PS") W !!?6,"Search Template used: ",$P(^DIBT(BWGRSEAT,0),U),!
I '$D(^BWGRTRPT(BWGRRPT,11)) G SHOWP
S BWGRI=0 F S BWGRI=$O(^BWGRTRPT(BWGRRPT,11,BWGRI)) Q:BWGRI'=+BWGRI D
.I $Y>(IOSL-5) D PAUSE^BWGRVL W @IOF
.W !?6,$P(^BWGRI(BWGRI,0),U),": "
.K BWGRQ S BWGRY="",C=0 K BWGRQ F S BWGRY=$O(^BWGRTRPT(BWGRRPT,11,BWGRI,11,"B",BWGRY)) S C=C+1 W:C'=1&(BWGRY'="") " ; " Q:BWGRY=""!($D(BWGRQ)) S X=BWGRY X:$D(^BWGRI(BWGRI,2)) ^(2) W X
K BWGRQ
SHOWP ;
W !!,"REPORT/OUTPUT TYPE",!
I BWGRCTYP="F" D D PAUSE^BWGRVL W @IOF Q
.W ?6,"A File of records called ",BWGRFILE," will be created."
.W !?6,"Total number of procedures counted is ",BWGRRCNT,"."
I BWGRCTYP="T" D COUNT Q
I BWGRCTYP="S" D I 1
.I $Y>(IOSL-6) D PAUSE^BWGRVL W @IOF
.W ?6,"Report will contain sub-totals by ",$P(^BWGRI(BWGRSORT,0),U)," and ",!?6,"total counts."
.I '$D(^XTMP("BWGRVL",BWGRJOB,BWGRBTH)) W !!,"NO DATA TO REPORT.",! D PAUSE^BWGRVL W:$D(IOF) @IOF
.Q
I BWGRCTYP'="D" D PAUSE^BWGRVL W:$D(IOF) @IOF Q
I $Y>(IOSL-4) D PAUSE^BWGRVL W @IOF
W ?6,"Detailed Listing containing"
I '$D(^BWGRTRPT(BWGRRPT,12)) G PAUSE
S BWGRI=0 F S BWGRI=$O(^BWGRTRPT(BWGRRPT,12,BWGRI)) Q:BWGRI'=+BWGRI S BWGRCRIT=$P(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U) D
.I $Y>(IOSL-4) D PAUSE^BWGRVL W:$D(IOF) @IOF
.W !?6,$P(^BWGRI(BWGRCRIT,0),U)," (" S X=$O(^BWGRTRPT(BWGRRPT,12,"B",BWGRCRIT,"")) W $P(^BWGRTRPT(BWGRRPT,12,X,0),U,2),")"
I $Y>(IOSL-4) D PAUSE^BWGRVL W:$D(IOF) @IOF
W !?10," TOTAL column width: ",BWGRTCW
Q:'$G(BWGRSORT)
I $Y>(IOSL-4) D PAUSE^BWGRVL W:$D(IOF) @IOF
W !!,$S(BWGRPTVS="R":"Procedures",1:"Patients")," will be SORTED by: ",$P(^BWGRI(BWGRSORT,0),U),!
I $Y>(IOSL-4) D PAUSE^BWGRVL W:$D(IOF) @IOF
I $G(BWGRSPAG) W !?6,"Each ",$P(^BWGRI(BWGRSORT,0),U)," will be on a separate page.",!
I '$D(^XTMP("BWGRVL",BWGRJOB,BWGRBTH)) W !!,"NO DATA TO REPORT.",!
PAUSE D PAUSE^BWGRVL W:$D(IOF) @IOF
Q
COUNT ;if COUNTING entries only
I $Y>(IOSL-5) D PAUSE^BWGRVL W:$D(IOF) @IOF
W ?6,"Totals Displayed"
I '$D(^XTMP("BWGRVL",BWGRJOB,BWGRBTH)) W !!!,"NO DATA TO REPORT.",!
W:$D(BWGRRCNT) !!!?6,"Total COUNT of ",$S(BWGRPTVS="P":"Patients",1:"Procedures"),": ",?34,BWGRRCNT
W:BWGRPTVS="R" !?6,"Total COUNT of Patients: ",?34,BWGRPTCT
Q
WP ;EP - Entry point to print wp fields pass node in BWGRNODE
;PASS FILE IN BWGRFILE, ENTRY IN BWGRDA
K ^UTILITY($J,"W")
S BWGRRLX=0
S BWGRG1=^DIC(BWGRFILE,0,"GL"),BWGRG=BWGRG1_BWGRDA_","_BWGRNODE_",BWGRRLX)",BWGRGR=BWGRG1_BWGRDA_","_BWGRNODE_",BWGRRLX"
S DIWL=1,DIWR=$P(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2) F S BWGRRLX=$O(@BWGRG) Q:BWGRRLX'=+BWGRRLX D
.S Y=BWGRGR_",0)" S X=@Y D ^DIWP
.Q
S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z S BWGRPCNT=BWGRPCNT+1,BWGRPRNM(BWGRPCNT)=^UTILITY($J,"W",DIWL,Z,0)
K DIWL,DIWR,DIWF,Z
K ^UTILITY($J,"W"),BWGRNODE,BWGRFILE,BWGRDA,BWGRG1,BWGRGR,BWGRRLX
Q
BWGRVLP1 ; IHS/CMI/LAB - CONT OF BWGRVLP ;15-Feb-2003 21:53;PLS
+1 ;;2.0;WOMEN'S HEALTH;**6,8**;MAY 16, 1996
+2 ;
+3 ;
COVPAGE ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !?20,"WOMENS' HEALTH MANAGEMENT REPORTS ",$SELECT(BWGRPTVS="P":"WH PATIENT",1:"WH PROCEDURE")," ",$SELECT(BWGRCTYP="D":"LISTING",1:"COUNT")
+3 WRITE !?34,"SUMMARY PAGE"
+4 WRITE !!,"REPORT REQUESTED BY: ",$PIECE(^VA(200,DUZ,0),U),!
SHOW ;
+1 WRITE !,$SELECT(BWGRPTVS="P":"WH PATIENT",1:"WH PROCEDURE")," Selection Criteria"
+2 IF BWGRTYPE["V"
WRITE !?6,"Encounter Date range: ",BWGRBDD," to ",BWGREDD
+3 IF BWGRTYPE="VP"!(BWGRTYPE="VV")!(BWGRTYPE="PS")
WRITE !!?6,"Search Template used: ",$PIECE(^DIBT(BWGRSEAT,0),U),!
+4 IF '$DATA(^BWGRTRPT(BWGRRPT,11))
GOTO SHOWP
+5 SET BWGRI=0
FOR
SET BWGRI=$ORDER(^BWGRTRPT(BWGRRPT,11,BWGRI))
IF BWGRI'=+BWGRI
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-5)
DO PAUSE^BWGRVL
WRITE @IOF
+7 WRITE !?6,$PIECE(^BWGRI(BWGRI,0),U),": "
+8 KILL BWGRQ
SET BWGRY=""
SET C=0
KILL BWGRQ
FOR
SET BWGRY=$ORDER(^BWGRTRPT(BWGRRPT,11,BWGRI,11,"B",BWGRY))
SET C=C+1
IF C'=1&(BWGRY'="")
WRITE " ; "
IF BWGRY=""!($DATA(BWGRQ))
QUIT
SET X=BWGRY
IF $DATA(^BWGRI(BWGRI,2))
XECUTE ^(2)
WRITE X
End DoDot:1
+9 KILL BWGRQ
SHOWP ;
+1 WRITE !!,"REPORT/OUTPUT TYPE",!
+2 IF BWGRCTYP="F"
Begin DoDot:1
+3 WRITE ?6,"A File of records called ",BWGRFILE," will be created."
+4 WRITE !?6,"Total number of procedures counted is ",BWGRRCNT,"."
End DoDot:1
DO PAUSE^BWGRVL
WRITE @IOF
QUIT
+5 IF BWGRCTYP="T"
DO COUNT
QUIT
+6 IF BWGRCTYP="S"
Begin DoDot:1
+7 IF $Y>(IOSL-6)
DO PAUSE^BWGRVL
WRITE @IOF
+8 WRITE ?6,"Report will contain sub-totals by ",$PIECE(^BWGRI(BWGRSORT,0),U)," and ",!?6,"total counts."
+9 IF '$DATA(^XTMP("BWGRVL",BWGRJOB,BWGRBTH))
WRITE !!,"NO DATA TO REPORT.",!
DO PAUSE^BWGRVL
IF $DATA(IOF)
WRITE @IOF
+10 QUIT
End DoDot:1
IF 1
+11 IF BWGRCTYP'="D"
DO PAUSE^BWGRVL
IF $DATA(IOF)
WRITE @IOF
QUIT
+12 IF $Y>(IOSL-4)
DO PAUSE^BWGRVL
WRITE @IOF
+13 WRITE ?6,"Detailed Listing containing"
+14 IF '$DATA(^BWGRTRPT(BWGRRPT,12))
GOTO PAUSE
+15 SET BWGRI=0
FOR
SET BWGRI=$ORDER(^BWGRTRPT(BWGRRPT,12,BWGRI))
IF BWGRI'=+BWGRI
QUIT
SET BWGRCRIT=$PIECE(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U)
Begin DoDot:1
+16 IF $Y>(IOSL-4)
DO PAUSE^BWGRVL
IF $DATA(IOF)
WRITE @IOF
+17 WRITE !?6,$PIECE(^BWGRI(BWGRCRIT,0),U)," ("
SET X=$ORDER(^BWGRTRPT(BWGRRPT,12,"B",BWGRCRIT,""))
WRITE $PIECE(^BWGRTRPT(BWGRRPT,12,X,0),U,2),")"
End DoDot:1
+18 IF $Y>(IOSL-4)
DO PAUSE^BWGRVL
IF $DATA(IOF)
WRITE @IOF
+19 WRITE !?10," TOTAL column width: ",BWGRTCW
+20 IF '$GET(BWGRSORT)
QUIT
+21 IF $Y>(IOSL-4)
DO PAUSE^BWGRVL
IF $DATA(IOF)
WRITE @IOF
+22 WRITE !!,$SELECT(BWGRPTVS="R":"Procedures",1:"Patients")," will be SORTED by: ",$PIECE(^BWGRI(BWGRSORT,0),U),!
+23 IF $Y>(IOSL-4)
DO PAUSE^BWGRVL
IF $DATA(IOF)
WRITE @IOF
+24 IF $GET(BWGRSPAG)
WRITE !?6,"Each ",$PIECE(^BWGRI(BWGRSORT,0),U)," will be on a separate page.",!
+25 IF '$DATA(^XTMP("BWGRVL",BWGRJOB,BWGRBTH))
WRITE !!,"NO DATA TO REPORT.",!
PAUSE DO PAUSE^BWGRVL
IF $DATA(IOF)
WRITE @IOF
+1 QUIT
COUNT ;if COUNTING entries only
+1 IF $Y>(IOSL-5)
DO PAUSE^BWGRVL
IF $DATA(IOF)
WRITE @IOF
+2 WRITE ?6,"Totals Displayed"
+3 IF '$DATA(^XTMP("BWGRVL",BWGRJOB,BWGRBTH))
WRITE !!!,"NO DATA TO REPORT.",!
+4 IF $DATA(BWGRRCNT)
WRITE !!!?6,"Total COUNT of ",$SELECT(BWGRPTVS="P":"Patients",1:"Procedures"),": ",?34,BWGRRCNT
+5 IF BWGRPTVS="R"
WRITE !?6,"Total COUNT of Patients: ",?34,BWGRPTCT
+6 QUIT
WP ;EP - Entry point to print wp fields pass node in BWGRNODE
+1 ;PASS FILE IN BWGRFILE, ENTRY IN BWGRDA
+2 KILL ^UTILITY($JOB,"W")
+3 SET BWGRRLX=0
+4 SET BWGRG1=^DIC(BWGRFILE,0,"GL")
SET BWGRG=BWGRG1_BWGRDA_","_BWGRNODE_",BWGRRLX)"
SET BWGRGR=BWGRG1_BWGRDA_","_BWGRNODE_",BWGRRLX"
+5 SET DIWL=1
SET DIWR=$PIECE(^BWGRTRPT(BWGRRPT,12,BWGRI,0),U,2)
FOR
SET BWGRRLX=$ORDER(@BWGRG)
IF BWGRRLX'=+BWGRRLX
QUIT
Begin DoDot:1
+6 SET Y=BWGRGR_",0)"
SET X=@Y
DO ^DIWP
+7 QUIT
End DoDot:1
+8 SET Z=0
FOR
SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
IF Z'=+Z
QUIT
SET BWGRPCNT=BWGRPCNT+1
SET BWGRPRNM(BWGRPCNT)=^UTILITY($JOB,"W",DIWL,Z,0)
+9 KILL DIWL,DIWR,DIWF,Z
+10 KILL ^UTILITY($JOB,"W"),BWGRNODE,BWGRFILE,BWGRDA,BWGRG1,BWGRGR,BWGRRLX
+11 QUIT
