- BNITGS ; IHS/CMI/LAB - group served table ;
- ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
- ;
- ;
- START ;
- W:$D(IOF) @IOF
- W !,$$CTR($$LOC)
- W !,$$CTR($$USR)
- W !!,"This report will list the CPHAD Group Served table.",!!
- SORT ;
- S BNISORT=""
- K DIR S DIR(0)="S^T:Group Served;C:Group Served Code",DIR("A")="How do you want the table sorted",DIR("B")="T" KILL DA D ^DIR KILL DIR
- I $D(DIRUT) D EXIT Q
- S BNISORT=Y
- ZIS ;call to XBDBQUE
- S XBRP="PRINT^BNITGS",XBRC="",XBRX="EXIT^BNITGS",XBNS="BNI"
- D ^XBDBQUE
- D EXIT
- Q
- EXIT ;clean up and exit
- D EN^XBVK("BNI")
- Q
- PRINT ;EP - called from xbdbque
- S BNIPG=0,BNIQ="" D HEAD
- I BNISORT="C" D CODE
- I BNISORT="T" D TOPIC
- DONE ;
- I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. HIT RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- Q
- CODE ;
- S BNIX="" F S BNIX=$O(^BNIGS("C",BNIX)) Q:BNIX=""!(BNIQ) D
- .S BNIY=0 F S BNIY=$O(^BNIGS("C",BNIX,BNIY)) Q:BNIY'=+BNIY!(BNIQ) D
- ..I $Y>(IOSL-2) D HEAD Q:BNIQ
- ..W !,$P(^BNIGS(BNIY,0),U),?60,$P(^BNIGS(BNIY,0),U,2),?68,$$VAL^XBDIQ1(90511.04,BNIY,.03)
- ..Q
- .Q
- Q
- TOPIC ;
- S BNIX="" F S BNIX=$O(^BNIGS("B",BNIX)) Q:BNIX=""!(BNIQ) D
- .S BNIY=0 F S BNIY=$O(^BNIGS("B",BNIX,BNIY)) Q:BNIY'=+BNIY!(BNIQ) D
- ..I $Y>(IOSL-2) D HEAD Q:BNIQ
- ..W !,$P(^BNIGS(BNIY,0),U),?65,$P(^BNIGS(BNIY,0),U,2),?74,$$VAL^XBDIQ1(90511.04,BNIY,.03)
- ..Q
- .Q
- Q
- HEAD I 'BNIPG 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 BNIQ=1 Q
- HEAD1 ;
- W:$D(IOF) @IOF S BNIPG=BNIPG+1
- W !,$P(^VA(200,DUZ,0),U,2),?72,"Page ",BNIPG,!
- W ?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),!
- W $$CTR("CPHAD GROUP SERVED TABLE LISTING",80),!
- PIH W !,"GROUP SERVED",?60,"CODE",?68,"OTHER?",!,$$REPEAT^XLFSTR("-",80),!
- Q
- CTR(X,Y) ;EP - Center X in a field Y wide.
- Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
- ;----------
- EOP ;EP - End of page.
- Q:$E(IOST)'="C"
- Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
- NEW DIR
- K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
- S DIR(0)="E" D ^DIR
- Q
- ;----------
- USR() ;EP - Return name of current user from ^VA(200.
- Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
- ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- ;----------
- BNITGS ; IHS/CMI/LAB - group served table ;
- +1 ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
- +2 ;
- +3 ;
- START ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !,$$CTR($$LOC)
- +3 WRITE !,$$CTR($$USR)
- +4 WRITE !!,"This report will list the CPHAD Group Served table.",!!
- SORT ;
- +1 SET BNISORT=""
- +2 KILL DIR
- SET DIR(0)="S^T:Group Served;C:Group Served Code"
- SET DIR("A")="How do you want the table sorted"
- SET DIR("B")="T"
- KILL DA
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DIRUT)
- DO EXIT
- QUIT
- +4 SET BNISORT=Y
- ZIS ;call to XBDBQUE
- +1 SET XBRP="PRINT^BNITGS"
- SET XBRC=""
- SET XBRX="EXIT^BNITGS"
- SET XBNS="BNI"
- +2 DO ^XBDBQUE
- +3 DO EXIT
- +4 QUIT
- EXIT ;clean up and exit
- +1 DO EN^XBVK("BNI")
- +2 QUIT
- PRINT ;EP - called from xbdbque
- +1 SET BNIPG=0
- SET BNIQ=""
- DO HEAD
- +2 IF BNISORT="C"
- DO CODE
- +3 IF BNISORT="T"
- DO TOPIC
- DONE ;
- +1 IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- SET DIR(0)="EO"
- SET DIR("A")="End of report. HIT RETURN"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +2 QUIT
- CODE ;
- +1 SET BNIX=""
- FOR
- SET BNIX=$ORDER(^BNIGS("C",BNIX))
- IF BNIX=""!(BNIQ)
- QUIT
- Begin DoDot:1
- +2 SET BNIY=0
- FOR
- SET BNIY=$ORDER(^BNIGS("C",BNIX,BNIY))
- IF BNIY'=+BNIY!(BNIQ)
- QUIT
- Begin DoDot:2
- +3 IF $Y>(IOSL-2)
- DO HEAD
- IF BNIQ
- QUIT
- +4 WRITE !,$PIECE(^BNIGS(BNIY,0),U),?60,$PIECE(^BNIGS(BNIY,0),U,2),?68,$$VAL^XBDIQ1(90511.04,BNIY,.03)
- +5 QUIT
- End DoDot:2
- +6 QUIT
- End DoDot:1
- +7 QUIT
- TOPIC ;
- +1 SET BNIX=""
- FOR
- SET BNIX=$ORDER(^BNIGS("B",BNIX))
- IF BNIX=""!(BNIQ)
- QUIT
- Begin DoDot:1
- +2 SET BNIY=0
- FOR
- SET BNIY=$ORDER(^BNIGS("B",BNIX,BNIY))
- IF BNIY'=+BNIY!(BNIQ)
- QUIT
- Begin DoDot:2
- +3 IF $Y>(IOSL-2)
- DO HEAD
- IF BNIQ
- QUIT
- +4 WRITE !,$PIECE(^BNIGS(BNIY,0),U),?65,$PIECE(^BNIGS(BNIY,0),U,2),?74,$$VAL^XBDIQ1(90511.04,BNIY,.03)
- +5 QUIT
- End DoDot:2
- +6 QUIT
- End DoDot:1
- +7 QUIT
- HEAD IF 'BNIPG
- GOTO HEAD1
- +1 IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- WRITE !
- SET DIR(0)="EO"
- DO ^DIR
- KILL DIR
- IF Y=0!(Y="^")!($DATA(DTOUT))
- SET BNIQ=1
- QUIT
- HEAD1 ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- SET BNIPG=BNIPG+1
- +2 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?72,"Page ",BNIPG,!
- +3 WRITE ?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),!
- +4 WRITE $$CTR("CPHAD GROUP SERVED TABLE LISTING",80),!
- PIH WRITE !,"GROUP SERVED",?60,"CODE",?68,"OTHER?",!,$$REPEAT^XLFSTR("-",80),!
- +1 QUIT
- CTR(X,Y) ;EP - Center X in a field Y wide.
- +1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
- +2 ;----------
- EOP ;EP - End of page.
- +1 IF $EXTRACT(IOST)'="C"
- QUIT
- +2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
- QUIT
- +3 NEW DIR
- +4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
- +5 SET DIR(0)="E"
- DO ^DIR
- +6 QUIT
- +7 ;----------
- USR() ;EP - Return name of current user from ^VA(200.
- +1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
- +2 ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- +1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- +2 ;----------
