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
