- 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
