- BNIGVLP1 ; IHS/CMI/LAB - CONT OF BNIGVLP ;
- ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
- ;
- ;
- COVPAGE ;EP
- W:$D(IOF) @IOF
- ;I $G(BNIGUI) W "ZZZZZZZ",!
- W !?20,"CPHAD General Retrieval Report ",$S(BNIGCTYP="D":"LISTING",1:"COUNT")
- W !?34,"SUMMARY PAGE"
- W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U),!
- SHOW ;
- W !,"CPHAD Activity Record Selection Criteria"
- W !?6,"Date range: ",BNIGBDD," to ",BNIGEDD
- I '$D(^BNIRTMP(BNIGRPT,11)) G SHOWP
- S BNIGI=0 F S BNIGI=$O(^BNIRTMP(BNIGRPT,11,BNIGI)) Q:BNIGI'=+BNIGI D
- .I $Y>(BNIIOSL-5) D PAUSE^BNIGVL W @IOF I $G(BNIGUI) W "ZZZZZZZ",!
- .W !?6,$P(^BNIGRI(BNIGI,0),U),": "
- .K BNIGQ S BNIGY="",C=0 K BNIGQ F S BNIGY=$O(^BNIRTMP(BNIGRPT,11,BNIGI,11,"B",BNIGY)) S C=C+1 W:C'=1&(BNIGY'="") " ; " Q:BNIGY=""!($D(BNIGQ)) S X=BNIGY X:$D(^BNIGRI(BNIGI,2)) ^(2) W X
- K BNIGQ
- SHOWP ;
- W !!,"REPORT/OUTPUT TYPE",!
- I BNIGCTYP="F" D D PAUSE^BNIGVL W @IOF W:$G(BNIGUI) "ZZZZZZZ",! Q
- .W ?6,"A File of records called ",BNIGFILE," will be created."
- .W !?6,"Total number of procedures counted is ",BNIGRCNT,"."
- I BNIGCTYP="T" D COUNT Q
- I BNIGCTYP="S" D I 1
- .I $Y>(BNIIOSL-6) D PAUSE^BNIGVL W @IOF I $G(BNIGUI) W "ZZZZZZZ",!
- .W ?6,"Report will contain sub-totals by ",$P(^BNIGRI(BNIGSORT,0),U)," and ",!?6,"total counts."
- .I '$D(^XTMP("BNIGVL",BNIGJOB,BNIGBTH)) W !!,"NO DATA TO REPORT.",! D PAUSE^BNIGVL W:$D(IOF) @IOF I $G(BNIGUI) W "ZZZZZZZ",!
- .Q
- I BNIGCTYP'="D",BNIGCTYP'="L" D PAUSE^BNIGVL W:$D(IOF) @IOF W:$G(BNIGUI) "ZZZZZZZ",! Q
- I $Y>(BNIIOSL-4) D PAUSE^BNIGVL W @IOF I $G(BNIGUI) W "ZZZZZZZ",!
- W ?6,"Detailed Listing containing"
- I BNIGCTYP="L" D
- .W !?5,"PLEASE NOTE: The first column of the delimited output will always"
- .W !?5," be the record internal entry number which uniquely"
- .W !?5," identifies the record. "
- .W ?6,"A File of records called ",BNIGDELF," will be created."
- I BNIGCTYP="L" W !?6,"Delimited output file will contain:"
- I '$D(^BNIRTMP(BNIGRPT,12)) G PAUSE
- S BNIGI=0 F S BNIGI=$O(^BNIRTMP(BNIGRPT,12,BNIGI)) Q:BNIGI'=+BNIGI S BNIGCRIT=$P(^BNIRTMP(BNIGRPT,12,BNIGI,0),U) D
- .I $Y>(BNIIOSL-4) D PAUSE^BNIGVL W:$D(IOF) @IOF I $G(BNIGUI) W "ZZZZZZZ",!
- .W !?6,$P(^BNIGRI(BNIGCRIT,0),U)," (" S X=$O(^BNIRTMP(BNIGRPT,12,"B",BNIGCRIT,"")) W $P(^BNIRTMP(BNIGRPT,12,X,0),U,2),")"
- I $Y>(BNIIOSL-4) D PAUSE^BNIGVL W:$D(IOF) @IOF I $G(BNIGUI) W "ZZZZZZZ",!
- W !?10," TOTAL column width: ",BNIGTCW
- Q:'$G(BNIGSORT)
- I $Y>(BNIIOSL-4) D PAUSE^BNIGVL W:$D(IOF) @IOF I $G(BNIGUI) W "ZZZZZZZ",!
- W !!,"CPHAD Activity Records will be SORTED by: ",$P(^BNIGRI(BNIGSORT,0),U),!
- I $Y>(BNIIOSL-4) D PAUSE^BNIGVL W:$D(IOF) @IOF I $G(BNIGUI) W "ZZZZZZZ",!
- I $G(BNIGSPAG) W !?6,"Each ",$P(^BNIGRI(BNIGSORT,0),U)," will be on a separate page.",!
- I '$D(^XTMP("BNIGVL",BNIGJOB,BNIGBTH)) W !!,"NO DATA TO REPORT.",!
- PAUSE D PAUSE^BNIGVL W:$D(IOF) @IOF I $G(BNIGUI) W "ZZZZZZZ",!
- Q
- COUNT ;if COUNTING entries only
- I $Y>(BNIIOSL-5) D PAUSE^BNIGVL W:$D(IOF) @IOF I $G(BNIGUI) W "ZZZZZZZ",!
- W ?6,"Totals Displayed"
- I '$D(^XTMP("BNIGVL",BNIGJOB,BNIGBTH)) W !!!,"NO DATA TO REPORT.",!
- W:$D(BNIGRCNT) !!!?6,"Total COUNT of CPHAD Activity Records: ",?34,BNIGRCNT
- Q
- WP ;EP - Entry point to print wp fields pass node in BNIGNODE
- ;PASS FILE IN BNIGFILE, ENTRY IN BNIGDA
- K ^UTILITY($J,"W")
- S BNIGRLX=0
- S BNIGG1=^DIC(BNIGFILE,0,"GL"),BNIGG=BNIGG1_BNIGDA_","_BNIGNODE_",BNIGRLX)",BNIGGR=BNIGG1_BNIGDA_","_BNIGNODE_",BNIGRLX"
- S DIWL=1,DIWR=$P(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2) F S BNIGRLX=$O(@BNIGG) Q:BNIGRLX'=+BNIGRLX D
- .S Y=BNIGGR_",0)" S X=@Y D ^DIWP
- .Q
- S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z S BNIGPCNT=BNIGPCNT+1,BNIGPRNM(BNIGPCNT)=^UTILITY($J,"W",DIWL,Z,0)
- K DIWL,DIWR,DIWF,Z
- K ^UTILITY($J,"W"),BNIGNODE,BNIGFILE,BNIGDA,BNIGG1,BNIGGR,BNIGRLX
- Q
- BNIGVLP1 ; IHS/CMI/LAB - CONT OF BNIGVLP ;
- +1 ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
- +2 ;
- +3 ;
- COVPAGE ;EP
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 ;I $G(BNIGUI) W "ZZZZZZZ",!
- +3 WRITE !?20,"CPHAD General Retrieval Report ",$SELECT(BNIGCTYP="D":"LISTING",1:"COUNT")
- +4 WRITE !?34,"SUMMARY PAGE"
- +5 WRITE !!,"REPORT REQUESTED BY: ",$PIECE(^VA(200,DUZ,0),U),!
- SHOW ;
- +1 WRITE !,"CPHAD Activity Record Selection Criteria"
- +2 WRITE !?6,"Date range: ",BNIGBDD," to ",BNIGEDD
- +3 IF '$DATA(^BNIRTMP(BNIGRPT,11))
- GOTO SHOWP
- +4 SET BNIGI=0
- FOR
- SET BNIGI=$ORDER(^BNIRTMP(BNIGRPT,11,BNIGI))
- IF BNIGI'=+BNIGI
- QUIT
- Begin DoDot:1
- +5 IF $Y>(BNIIOSL-5)
- DO PAUSE^BNIGVL
- WRITE @IOF
- IF $GET(BNIGUI)
- WRITE "ZZZZZZZ",!
- +6 WRITE !?6,$PIECE(^BNIGRI(BNIGI,0),U),": "
- +7 KILL BNIGQ
- SET BNIGY=""
- SET C=0
- KILL BNIGQ
- FOR
- SET BNIGY=$ORDER(^BNIRTMP(BNIGRPT,11,BNIGI,11,"B",BNIGY))
- SET C=C+1
- IF C'=1&(BNIGY'="")
- WRITE " ; "
- IF BNIGY=""!($DATA(BNIGQ))
- QUIT
- SET X=BNIGY
- IF $DATA(^BNIGRI(BNIGI,2))
- XECUTE ^(2)
- WRITE X
- End DoDot:1
- +8 KILL BNIGQ
- SHOWP ;
- +1 WRITE !!,"REPORT/OUTPUT TYPE",!
- +2 IF BNIGCTYP="F"
- Begin DoDot:1
- +3 WRITE ?6,"A File of records called ",BNIGFILE," will be created."
- +4 WRITE !?6,"Total number of procedures counted is ",BNIGRCNT,"."
- End DoDot:1
- DO PAUSE^BNIGVL
- WRITE @IOF
- IF $GET(BNIGUI)
- WRITE "ZZZZZZZ",!
- QUIT
- +5 IF BNIGCTYP="T"
- DO COUNT
- QUIT
- +6 IF BNIGCTYP="S"
- Begin DoDot:1
- +7 IF $Y>(BNIIOSL-6)
- DO PAUSE^BNIGVL
- WRITE @IOF
- IF $GET(BNIGUI)
- WRITE "ZZZZZZZ",!
- +8 WRITE ?6,"Report will contain sub-totals by ",$PIECE(^BNIGRI(BNIGSORT,0),U)," and ",!?6,"total counts."
- +9 IF '$DATA(^XTMP("BNIGVL",BNIGJOB,BNIGBTH))
- WRITE !!,"NO DATA TO REPORT.",!
- DO PAUSE^BNIGVL
- IF $DATA(IOF)
- WRITE @IOF
- IF $GET(BNIGUI)
- WRITE "ZZZZZZZ",!
- +10 QUIT
- End DoDot:1
- IF 1
- +11 IF BNIGCTYP'="D"
- IF BNIGCTYP'="L"
- DO PAUSE^BNIGVL
- IF $DATA(IOF)
- WRITE @IOF
- IF $GET(BNIGUI)
- WRITE "ZZZZZZZ",!
- QUIT
- +12 IF $Y>(BNIIOSL-4)
- DO PAUSE^BNIGVL
- WRITE @IOF
- IF $GET(BNIGUI)
- WRITE "ZZZZZZZ",!
- +13 WRITE ?6,"Detailed Listing containing"
- +14 IF BNIGCTYP="L"
- Begin DoDot:1
- +15 WRITE !?5,"PLEASE NOTE: The first column of the delimited output will always"
- +16 WRITE !?5," be the record internal entry number which uniquely"
- +17 WRITE !?5," identifies the record. "
- +18 WRITE ?6,"A File of records called ",BNIGDELF," will be created."
- End DoDot:1
- +19 IF BNIGCTYP="L"
- WRITE !?6,"Delimited output file will contain:"
- +20 IF '$DATA(^BNIRTMP(BNIGRPT,12))
- GOTO PAUSE
- +21 SET BNIGI=0
- FOR
- SET BNIGI=$ORDER(^BNIRTMP(BNIGRPT,12,BNIGI))
- IF BNIGI'=+BNIGI
- QUIT
- SET BNIGCRIT=$PIECE(^BNIRTMP(BNIGRPT,12,BNIGI,0),U)
- Begin DoDot:1
- +22 IF $Y>(BNIIOSL-4)
- DO PAUSE^BNIGVL
- IF $DATA(IOF)
- WRITE @IOF
- IF $GET(BNIGUI)
- WRITE "ZZZZZZZ",!
- +23 WRITE !?6,$PIECE(^BNIGRI(BNIGCRIT,0),U)," ("
- SET X=$ORDER(^BNIRTMP(BNIGRPT,12,"B",BNIGCRIT,""))
- WRITE $PIECE(^BNIRTMP(BNIGRPT,12,X,0),U,2),")"
- End DoDot:1
- +24 IF $Y>(BNIIOSL-4)
- DO PAUSE^BNIGVL
- IF $DATA(IOF)
- WRITE @IOF
- IF $GET(BNIGUI)
- WRITE "ZZZZZZZ",!
- +25 WRITE !?10," TOTAL column width: ",BNIGTCW
- +26 IF '$GET(BNIGSORT)
- QUIT
- +27 IF $Y>(BNIIOSL-4)
- DO PAUSE^BNIGVL
- IF $DATA(IOF)
- WRITE @IOF
- IF $GET(BNIGUI)
- WRITE "ZZZZZZZ",!
- +28 WRITE !!,"CPHAD Activity Records will be SORTED by: ",$PIECE(^BNIGRI(BNIGSORT,0),U),!
- +29 IF $Y>(BNIIOSL-4)
- DO PAUSE^BNIGVL
- IF $DATA(IOF)
- WRITE @IOF
- IF $GET(BNIGUI)
- WRITE "ZZZZZZZ",!
- +30 IF $GET(BNIGSPAG)
- WRITE !?6,"Each ",$PIECE(^BNIGRI(BNIGSORT,0),U)," will be on a separate page.",!
- +31 IF '$DATA(^XTMP("BNIGVL",BNIGJOB,BNIGBTH))
- WRITE !!,"NO DATA TO REPORT.",!
- PAUSE DO PAUSE^BNIGVL
- IF $DATA(IOF)
- WRITE @IOF
- IF $GET(BNIGUI)
- WRITE "ZZZZZZZ",!
- +1 QUIT
- COUNT ;if COUNTING entries only
- +1 IF $Y>(BNIIOSL-5)
- DO PAUSE^BNIGVL
- IF $DATA(IOF)
- WRITE @IOF
- IF $GET(BNIGUI)
- WRITE "ZZZZZZZ",!
- +2 WRITE ?6,"Totals Displayed"
- +3 IF '$DATA(^XTMP("BNIGVL",BNIGJOB,BNIGBTH))
- WRITE !!!,"NO DATA TO REPORT.",!
- +4 IF $DATA(BNIGRCNT)
- WRITE !!!?6,"Total COUNT of CPHAD Activity Records: ",?34,BNIGRCNT
- +5 QUIT
- WP ;EP - Entry point to print wp fields pass node in BNIGNODE
- +1 ;PASS FILE IN BNIGFILE, ENTRY IN BNIGDA
- +2 KILL ^UTILITY($JOB,"W")
- +3 SET BNIGRLX=0
- +4 SET BNIGG1=^DIC(BNIGFILE,0,"GL")
- SET BNIGG=BNIGG1_BNIGDA_","_BNIGNODE_",BNIGRLX)"
- SET BNIGGR=BNIGG1_BNIGDA_","_BNIGNODE_",BNIGRLX"
- +5 SET DIWL=1
- SET DIWR=$PIECE(^BNIRTMP(BNIGRPT,12,BNIGI,0),U,2)
- FOR
- SET BNIGRLX=$ORDER(@BNIGG)
- IF BNIGRLX'=+BNIGRLX
- QUIT
- Begin DoDot:1
- +6 SET Y=BNIGGR_",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 BNIGPCNT=BNIGPCNT+1
- SET BNIGPRNM(BNIGPCNT)=^UTILITY($JOB,"W",DIWL,Z,0)
- +9 KILL DIWL,DIWR,DIWF,Z
- +10 KILL ^UTILITY($JOB,"W"),BNIGNODE,BNIGFILE,BNIGDA,BNIGG1,BNIGGR,BNIGRLX
- +11 QUIT
