BNIRP6 ; IHS/CMI/LAB - gpra report ;
;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
;
START ;
D INFORM
GETDATES ;
BD ;get beginning date
W !
S BNIGBD=""
S DIR(0)="FO^6:7",DIR("A")="Enter Beginning Month (e.g. 01/2006)",DIR("?")="Enter a month and 4 digit year in the following format: 1/1999, 01/2000. The slash is required between the month and year. Date must be in the past."
KILL DA D ^DIR KILL DIR
Q:$D(DIRUT)
Q:X=""
I Y'?1.2N1"/"4N W !,"Enter the month/4 digit year in the format 03/2005. Slash is required and ",!,"4 digit year is required.",! G BD
K %DT S X=Y,%DT="EP" D ^%DT
I Y=-1 W !!,"Enter a month and 4 digit year. Date must be in the past. E.g. 04/2005 or 01/2000." G BD
I Y>DT W !!,"No future dates allowed!",! G BD
S BNIGBD=Y
ED ;get ending date
W !
S BNIGED=""
S DIR(0)="FO^6:7",DIR("A")="Enter Ending Month (e.g. 01/2006)",DIR("?")="Enter a month and 4 digit year in the following format: 1/1999, 01/2000. The slash is required between the month and year. Date must be in the past."
KILL DA D ^DIR KILL DIR
Q:$D(DIRUT)
Q:X=""
I Y'?1.2N1"/"4N W !,"Enter the month/4 digit year in the format 03/2005. Slash is required and ",!,"4 digit year is required.",! G ED
K %DT S X=Y,%DT="EP" D ^%DT
I Y=-1 W !!,"Enter a month and 4 digit year. Date must be in the past. E.g. 04/2005 or 01/2000." G ED
I Y>DT W !!,"No future dates allowed!",! G ED
S BNIGED=Y
S BNIGBDD=$$FMTE^XLFDT(BNIGBD),BNIGEDD=$$FMTE^XLFDT(BNIGED)
S X1=BNIGBD,X2=-1 D C^%DTC S BNIGSD=X
;
LIST ;
K BNILIST
K DIR S DIR(0)="Y",DIR("A")="Do you want a list of the records",DIR("B")="N" KILL DA D ^DIR K DIR
I $D(DIRUT) G GETDATES
S BNILIST=Y
ZIS ;call to XBDBQUE
S XBRP="PRINT^BNIRP6",XBRC="PROCESS^BNIRP6",XBRX="XIT^BNIRP6",XBNS="BNIG"
D ^XBDBQUE
D XIT
Q
PROCESS ;EP - called from xbdbque
S BNIJ=$J,BNIH=$H,BNIGTOTR=0,BNIGTOTT=0
K BNIGDATA
S ^XTMP("BNIRP6",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BNI CPHAD ACTIVITY REPORT"
S BNIGSD=BNIGSD_".9999"
F S BNIGSD=$O(^BNIREC("B",BNIGSD)) Q:BNIGSD=""!($E(BNIGSD,1,5)>$E(BNIGED,1,5)) D
.S BNIR=0 F S BNIR=$O(^BNIREC("B",BNIGSD,BNIR)) Q:BNIR'=+BNIR D PROC1
.Q
Q
PROC1 ;
S BNIREC=$G(^BNIREC(BNIR,0))
Q:BNIREC=""
S X=$$VALI^XBDIQ1(90510,BNIR,.12)
Q:X=""
Q:'$P(^BNISHT(X,0),U,4)
D SET
Q
SET ;
I BNILIST S ^XTMP("BNIRP6",BNIJ,BNIH,"RECORDS",$P(BNIREC,U),BNIR)=""
S BNIGTOTR=BNIGTOTR+1
S BNIGTOTT=BNIGTOTT+$P(BNIREC,U,9)
S BNIPRV=$$VAL^XBDIQ1(90510,BNIR,.12)
I BNIPRV="" S BNIPRV="UNKNOWN/BLANK"
I '$D(BNIGDATA(BNIPRV)) S BNIGDATA(BNIPRV)=""
S $P(BNIGDATA(BNIPRV),U,1)=$P(BNIGDATA(BNIPRV),U,1)+1
S $P(BNIGDATA(BNIPRV),U,2)=$P(BNIGDATA(BNIPRV),U,2)+$P(BNIREC,U,9)
Q
PRINT ;EP - called from xbdbque
S BNIGPG=0,BNIGQUIT=""
D HEADER
S BNIPRV="" F S BNIPRV=$O(BNIGDATA(BNIPRV)) Q:BNIPRV=""!(BNIGQUIT) D
.I $Y>(IOSL-2) D HEADER Q:BNIGQUIT
.W !,$E(BNIPRV,1,50)
.W ?55,$$C($P(BNIGDATA(BNIPRV),U,1),0,8),?68,$$C($P(BNIGDATA(BNIPRV),U,2),2,12)
I $Y>(IOSL-4) D HEADER Q:BNIGQUIT
W !!!,"GRAND TOTALS:",?55,$$C(BNIGTOTR,0,8),?68,$$C(BNIGTOTT,2,12)
I BNILIST D LISTP
W ! D EOP
Q
LISTP ;
D LHDR
S BNID=0 F S BNID=$O(^XTMP("BNIRP6",BNIJ,BNIH,"RECORDS",BNID)) Q:BNID'=+BNID!(BNIGQUIT) D
.S BNIR=0 F S BNIR=$O(^XTMP("BNIRP6",BNIJ,BNIH,"RECORDS",BNID,BNIR)) Q:BNIR'=+BNIR!(BNIGQUIT) D
..I $Y>(IOSL-4) D LHDR Q:BNIGQUIT
..W !,$$D($P(^BNIREC(BNIR,0),U)),?13,$E($$VAL^XBDIQ1(90510,BNIR,.08),1,15),?30,$P(^BNIREC(BNIR,0),U,9)
..W ?37,$E($$VAL^XBDIQ1(90510,BNIR,.15),1,20),?59,$E($$VAL^XBDIQ1(90510,BNIR,.13),1,15),?75,$$GPRA(BNIR)
..W !?3,$$VAL^XBDIQ1(90510,BNIR,.11)
..W !?3,$$VAL^XBDIQ1(90510,BNIR,.12)
..Q:'$O(^BNIREC(BNIR,14,0))
..S BNIX=0 F S BNIX=$O(^BNIREC(BNIR,14,BNIX)) Q:BNIX'=+BNIX!(BNIGQUIT) D
...I $Y>(IOSL-4) D LHDR Q:BNIGQUIT
...W !?1,^BNIREC(BNIR,14,BNIX,0)
...Q
..Q
.Q
K ^XTMP("BNIRP6",BNIJ,BNIH)
Q
GPRA(R) ;
S X=$$VALI^XBDIQ1(90510,BNIR,.12)
I X="" Q ""
I $P(^BNISHT(X,0),U,4) Q "GPRA"
Q ""
DATE(D) ;EP
I D="" Q ""
;Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+$E(D,1,3))
Q $$FMTE^XLFDT(D)
;
D(D) ;EP
I D="" Q ""
Q $$FMTE^XLFDT(D)
;
;
C(X,X2,X3) ;
D COMMA^%DTC
Q X
LHDR ;
I 'BNIGPG G LHDR1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BNIGQUIT=1 Q
LHDR1 ;
W:$D(IOF) @IOF S BNIGPG=BNIGPG+1
I $G(BNIGUI) W "ZZZZZZZ",! ;maw
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BNIGPG,!
W !,$$CTR("*** Computerized Public Health Actvity Datasystem ***",80)
W !,$$CTR("*** Activity Time for GPRA Elements ***",80)
W !,$$CTR("*** Record Listing ***",80)
W !,$$CTR($P(^DIC(4,DUZ(2),0),U),80)
S X="Activity Dates: "_$$FMTE^XLFDT(BNIGBD)_" to "_$$FMTE^XLFDT(BNIGED) W !,$$CTR(X,80)
W !!,"DATE",?10,"PROVIDER",?30,"Hrs",?37,"SETTING",?59,"ACTIVITY",?75,"GPRA"
W !,$$REPEAT^XLFSTR("-",80)
W !
Q
I 'BNIGPG 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 BNIGQUIT=1 Q
HEAD1 ;
W:$D(IOF) @IOF S BNIGPG=BNIGPG+1
;I $G(BNIGUI) W "ZZZZZZZ",! ;maw
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BNIGPG,!
W !,$$CTR("*** Computerized Public Health Actvity Datasystem ***",80)
W !,$$CTR("*** Activity Time for GPRA Elements ***",80)
W !,$$CTR($P(^DIC(4,DUZ(2),0),U),80)
S X="Activity Dates: "_$$FMTE^XLFDT(BNIGBD)_" to "_$$FMTE^XLFDT(BNIGED) W !,$$CTR(X,80)
W !,$$REPEAT^XLFSTR("-",80)
W !,?1,"SPECIFIC HEALTH TOPIC (GPRA RELATED)",?55,"# RECORDS",?73,"Hrs"
W !?55,"---------",?73,"---"
W !
Q
;
XIT ;
D EN^XBVK("BNI")
K X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M
Q
INFORM ;
W:$D(IOF) @IOF
W !!,$$CTR($$LOC)
W !!,$$CTR("TIME SPENT for GPRA Elements")
W !!,"This report will only look at Specific Health Topics that are GPRA"
W !,"related."
W !
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)!$D(IO("S"))
NEW DIR
K DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR(0)="E" D ^DIR KILL 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")
;----------
;
BNIG(BNIERR,BNIJOB,BNIBTH,BNIGBD,BNIGED,BNILIST,BNIRDT) ;PEP - gui call
I $G(BNIJOB)="" S BNIIEN=-1 Q
I $G(BNIBTH)="" S BNIIEN=-1 Q
I $G(BNIBG)="" S BNIIEN=-1 Q
I $G(BNIED)="" S BNIIEN=-1 Q
I $G(BNILIST)="" S BNIIEN=-1 Q
S BNIGBDD=$$FMTE^XLFDT(BNIGBD),BNIGEDD=$$FMTE^XLFDT(BNIGED)
S X1=BNIBG,X2=-1 D C^%DTC S BNIGSD=X
;create entry in fileman file to hold output
N BNIOPT ;maw
S BNIOPT="GPRA Elements"
D NOW^%DTC
S BNINOW=$G(%)
K DD,D0,DIC
S X=BNIJOB_"."_BNIBTH
S DIC("DR")=".02////"_DUZ_";.03////"_BNINOW_";.05////"_$G(BNIOPT)_";.06///R;.07///R"
S DIC="^BNIGUI(",DIC(0)="L",DIADD=1,DLAYGO=90512.08
D FILE^DICN
K DIADD,DLAYGO,DIC,DA
I Y=-1 S BNIIEN=-1 Q
S BNIIEN=+Y
S BNIGIEN=BNIIEN ;cmi/maw added
D ^XBFMK
K ZTSAVE S ZTSAVE("*")=""
;D GUIEP ;for interactive testing
S ZTIO="",ZTDTH=$$NOW^XLFDT,ZTRTN="GUIEP^BNIRP6",ZTDESC=BNIOPT D ^%ZTLOAD
D XIT
Q
GUIEP ;EP - called from taskman
D PROCESS
K ^TMP($J,"BNIRP6")
S IOM=80 ;cmi/maw added
D GUIR^XBLM("PRINT^BNIRP6","^TMP($J,""BNIRP6"",")
S X=0,C=0 F S X=$O(^TMP($J,"BNIRP6",X)) Q:X'=+X D
. S C=C+1
. N BNIDATA
. S BNIDATA=$G(^TMP($J,"BNIRP6",X))
. I BNIDATA="ZZZZZZZ" S BNIDATA=$C(12)
. S ^BNIGUI(BNIIEN,11,C,0)=BNIDATA
S ^BNIGUI(BNIIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
S DA=BNIIEN,DIK="^BNIGUI(" D IX1^DIK
D ENDLOG
S ZTREQ="@"
Q
;
ENDLOG ;-- write the end of the log
D NOW^%DTC
S BNINOW=$G(%)
S DIE="^BNIGUI(",DA=BNIIEN,DR=".04////"_BNINOW_";.06///C"
D ^DIE
K DIE,DR,DA
Q
;
BNIRP6 ; IHS/CMI/LAB - gpra report ;
+1 ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
+2 ;
START ;
+1 DO INFORM
GETDATES ;
BD ;get beginning date
+1 WRITE !
+2 SET BNIGBD=""
+3 SET DIR(0)="FO^6:7"
SET DIR("A")="Enter Beginning Month (e.g. 01/2006)"
SET DIR("?")="Enter a month and 4 digit year in the following format: 1/1999, 01/2000. The slash is required between the month and year. Date must be in the past."
+4 KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
QUIT
+6 IF X=""
QUIT
+7 IF Y'?1.2N1"/"4N
WRITE !,"Enter the month/4 digit year in the format 03/2005. Slash is required and ",!,"4 digit year is required.",!
GOTO BD
+8 KILL %DT
SET X=Y
SET %DT="EP"
DO ^%DT
+9 IF Y=-1
WRITE !!,"Enter a month and 4 digit year. Date must be in the past. E.g. 04/2005 or 01/2000."
GOTO BD
+10 IF Y>DT
WRITE !!,"No future dates allowed!",!
GOTO BD
+11 SET BNIGBD=Y
ED ;get ending date
+1 WRITE !
+2 SET BNIGED=""
+3 SET DIR(0)="FO^6:7"
SET DIR("A")="Enter Ending Month (e.g. 01/2006)"
SET DIR("?")="Enter a month and 4 digit year in the following format: 1/1999, 01/2000. The slash is required between the month and year. Date must be in the past."
+4 KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
QUIT
+6 IF X=""
QUIT
+7 IF Y'?1.2N1"/"4N
WRITE !,"Enter the month/4 digit year in the format 03/2005. Slash is required and ",!,"4 digit year is required.",!
GOTO ED
+8 KILL %DT
SET X=Y
SET %DT="EP"
DO ^%DT
+9 IF Y=-1
WRITE !!,"Enter a month and 4 digit year. Date must be in the past. E.g. 04/2005 or 01/2000."
GOTO ED
+10 IF Y>DT
WRITE !!,"No future dates allowed!",!
GOTO ED
+11 SET BNIGED=Y
+12 SET BNIGBDD=$$FMTE^XLFDT(BNIGBD)
SET BNIGEDD=$$FMTE^XLFDT(BNIGED)
+13 SET X1=BNIGBD
SET X2=-1
DO C^%DTC
SET BNIGSD=X
+14 ;
LIST ;
+1 KILL BNILIST
+2 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want a list of the records"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO GETDATES
+4 SET BNILIST=Y
ZIS ;call to XBDBQUE
+1 SET XBRP="PRINT^BNIRP6"
SET XBRC="PROCESS^BNIRP6"
SET XBRX="XIT^BNIRP6"
SET XBNS="BNIG"
+2 DO ^XBDBQUE
+3 DO XIT
+4 QUIT
PROCESS ;EP - called from xbdbque
+1 SET BNIJ=$JOB
SET BNIH=$HOROLOG
SET BNIGTOTR=0
SET BNIGTOTT=0
+2 KILL BNIGDATA
+3 SET ^XTMP("BNIRP6",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BNI CPHAD ACTIVITY REPORT"
+4 SET BNIGSD=BNIGSD_".9999"
+5 FOR
SET BNIGSD=$ORDER(^BNIREC("B",BNIGSD))
IF BNIGSD=""!($EXTRACT(BNIGSD,1,5)>$EXTRACT(BNIGED,1,5))
QUIT
Begin DoDot:1
+6 SET BNIR=0
FOR
SET BNIR=$ORDER(^BNIREC("B",BNIGSD,BNIR))
IF BNIR'=+BNIR
QUIT
DO PROC1
+7 QUIT
End DoDot:1
+8 QUIT
PROC1 ;
+1 SET BNIREC=$GET(^BNIREC(BNIR,0))
+2 IF BNIREC=""
QUIT
+3 SET X=$$VALI^XBDIQ1(90510,BNIR,.12)
+4 IF X=""
QUIT
+5 IF '$PIECE(^BNISHT(X,0),U,4)
QUIT
+6 DO SET
+7 QUIT
SET ;
+1 IF BNILIST
SET ^XTMP("BNIRP6",BNIJ,BNIH,"RECORDS",$PIECE(BNIREC,U),BNIR)=""
+2 SET BNIGTOTR=BNIGTOTR+1
+3 SET BNIGTOTT=BNIGTOTT+$PIECE(BNIREC,U,9)
+4 SET BNIPRV=$$VAL^XBDIQ1(90510,BNIR,.12)
+5 IF BNIPRV=""
SET BNIPRV="UNKNOWN/BLANK"
+6 IF '$DATA(BNIGDATA(BNIPRV))
SET BNIGDATA(BNIPRV)=""
+7 SET $PIECE(BNIGDATA(BNIPRV),U,1)=$PIECE(BNIGDATA(BNIPRV),U,1)+1
+8 SET $PIECE(BNIGDATA(BNIPRV),U,2)=$PIECE(BNIGDATA(BNIPRV),U,2)+$PIECE(BNIREC,U,9)
+9 QUIT
PRINT ;EP - called from xbdbque
+1 SET BNIGPG=0
SET BNIGQUIT=""
+2 DO HEADER
+3 SET BNIPRV=""
FOR
SET BNIPRV=$ORDER(BNIGDATA(BNIPRV))
IF BNIPRV=""!(BNIGQUIT)
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-2)
DO HEADER
IF BNIGQUIT
QUIT
+5 WRITE !,$EXTRACT(BNIPRV,1,50)
+6 WRITE ?55,$$C($PIECE(BNIGDATA(BNIPRV),U,1),0,8),?68,$$C($PIECE(BNIGDATA(BNIPRV),U,2),2,12)
End DoDot:1
+7 IF $Y>(IOSL-4)
DO HEADER
IF BNIGQUIT
QUIT
+8 WRITE !!!,"GRAND TOTALS:",?55,$$C(BNIGTOTR,0,8),?68,$$C(BNIGTOTT,2,12)
+9 IF BNILIST
DO LISTP
+10 WRITE !
DO EOP
+11 QUIT
LISTP ;
+1 DO LHDR
+2 SET BNID=0
FOR
SET BNID=$ORDER(^XTMP("BNIRP6",BNIJ,BNIH,"RECORDS",BNID))
IF BNID'=+BNID!(BNIGQUIT)
QUIT
Begin DoDot:1
+3 SET BNIR=0
FOR
SET BNIR=$ORDER(^XTMP("BNIRP6",BNIJ,BNIH,"RECORDS",BNID,BNIR))
IF BNIR'=+BNIR!(BNIGQUIT)
QUIT
Begin DoDot:2
+4 IF $Y>(IOSL-4)
DO LHDR
IF BNIGQUIT
QUIT
+5 WRITE !,$$D($PIECE(^BNIREC(BNIR,0),U)),?13,$EXTRACT($$VAL^XBDIQ1(90510,BNIR,.08),1,15),?30,$PIECE(^BNIREC(BNIR,0),U,9)
+6 WRITE ?37,$EXTRACT($$VAL^XBDIQ1(90510,BNIR,.15),1,20),?59,$EXTRACT($$VAL^XBDIQ1(90510,BNIR,.13),1,15),?75,$$GPRA(BNIR)
+7 WRITE !?3,$$VAL^XBDIQ1(90510,BNIR,.11)
+8 WRITE !?3,$$VAL^XBDIQ1(90510,BNIR,.12)
+9 IF '$ORDER(^BNIREC(BNIR,14,0))
QUIT
+10 SET BNIX=0
FOR
SET BNIX=$ORDER(^BNIREC(BNIR,14,BNIX))
IF BNIX'=+BNIX!(BNIGQUIT)
QUIT
Begin DoDot:3
+11 IF $Y>(IOSL-4)
DO LHDR
IF BNIGQUIT
QUIT
+12 WRITE !?1,^BNIREC(BNIR,14,BNIX,0)
+13 QUIT
End DoDot:3
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 KILL ^XTMP("BNIRP6",BNIJ,BNIH)
+17 QUIT
GPRA(R) ;
+1 SET X=$$VALI^XBDIQ1(90510,BNIR,.12)
+2 IF X=""
QUIT ""
+3 IF $PIECE(^BNISHT(X,0),U,4)
QUIT "GPRA"
+4 QUIT ""
DATE(D) ;EP
+1 IF D=""
QUIT ""
+2 ;Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+$E(D,1,3))
+3 QUIT $$FMTE^XLFDT(D)
+4 ;
D(D) ;EP
+1 IF D=""
QUIT ""
+2 QUIT $$FMTE^XLFDT(D)
+3 ;
+4 ;
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
LHDR ;
+1 IF 'BNIGPG
GOTO LHDR1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BNIGQUIT=1
QUIT
LHDR1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BNIGPG=BNIGPG+1
+2 ;maw
IF $GET(BNIGUI)
WRITE "ZZZZZZZ",!
+3 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BNIGPG,!
+4 WRITE !,$$CTR("*** Computerized Public Health Actvity Datasystem ***",80)
+5 WRITE !,$$CTR("*** Activity Time for GPRA Elements ***",80)
+6 WRITE !,$$CTR("*** Record Listing ***",80)
+7 WRITE !,$$CTR($PIECE(^DIC(4,DUZ(2),0),U),80)
+8 SET X="Activity Dates: "_$$FMTE^XLFDT(BNIGBD)_" to "_$$FMTE^XLFDT(BNIGED)
WRITE !,$$CTR(X,80)
+9 WRITE !!,"DATE",?10,"PROVIDER",?30,"Hrs",?37,"SETTING",?59,"ACTIVITY",?75,"GPRA"
+10 WRITE !,$$REPEAT^XLFSTR("-",80)
+11 WRITE !
+12 QUIT
+1 IF 'BNIGPG
GOTO HEAD1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BNIGQUIT=1
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BNIGPG=BNIGPG+1
+2 ;I $G(BNIGUI) W "ZZZZZZZ",! ;maw
+3 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BNIGPG,!
+4 WRITE !,$$CTR("*** Computerized Public Health Actvity Datasystem ***",80)
+5 WRITE !,$$CTR("*** Activity Time for GPRA Elements ***",80)
+6 WRITE !,$$CTR($PIECE(^DIC(4,DUZ(2),0),U),80)
+7 SET X="Activity Dates: "_$$FMTE^XLFDT(BNIGBD)_" to "_$$FMTE^XLFDT(BNIGED)
WRITE !,$$CTR(X,80)
+8 WRITE !,$$REPEAT^XLFSTR("-",80)
+9 WRITE !,?1,"SPECIFIC HEALTH TOPIC (GPRA RELATED)",?55,"# RECORDS",?73,"Hrs"
+10 WRITE !?55,"---------",?73,"---"
+11 WRITE !
+12 QUIT
+13 ;
XIT ;
+1 DO EN^XBVK("BNI")
+2 KILL X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M
+3 QUIT
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!,$$CTR($$LOC)
+3 WRITE !!,$$CTR("TIME SPENT for GPRA Elements")
+4 WRITE !!,"This report will only look at Specific Health Topics that are GPRA"
+5 WRITE !,"related."
+6 WRITE !
+7 QUIT
+8 ;
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)!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
KILL 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 ;----------
+3 ;
BNIG(BNIERR,BNIJOB,BNIBTH,BNIGBD,BNIGED,BNILIST,BNIRDT) ;PEP - gui call
+1 IF $GET(BNIJOB)=""
SET BNIIEN=-1
QUIT
+2 IF $GET(BNIBTH)=""
SET BNIIEN=-1
QUIT
+3 IF $GET(BNIBG)=""
SET BNIIEN=-1
QUIT
+4 IF $GET(BNIED)=""
SET BNIIEN=-1
QUIT
+5 IF $GET(BNILIST)=""
SET BNIIEN=-1
QUIT
+6 SET BNIGBDD=$$FMTE^XLFDT(BNIGBD)
SET BNIGEDD=$$FMTE^XLFDT(BNIGED)
+7 SET X1=BNIBG
SET X2=-1
DO C^%DTC
SET BNIGSD=X
+8 ;create entry in fileman file to hold output
+9 ;maw
NEW BNIOPT
+10 SET BNIOPT="GPRA Elements"
+11 DO NOW^%DTC
+12 SET BNINOW=$GET(%)
+13 KILL DD,D0,DIC
+14 SET X=BNIJOB_"."_BNIBTH
+15 SET DIC("DR")=".02////"_DUZ_";.03////"_BNINOW_";.05////"_$GET(BNIOPT)_";.06///R;.07///R"
+16 SET DIC="^BNIGUI("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=90512.08
+17 DO FILE^DICN
+18 KILL DIADD,DLAYGO,DIC,DA
+19 IF Y=-1
SET BNIIEN=-1
QUIT
+20 SET BNIIEN=+Y
+21 ;cmi/maw added
SET BNIGIEN=BNIIEN
+22 DO ^XBFMK
+23 KILL ZTSAVE
SET ZTSAVE("*")=""
+24 ;D GUIEP ;for interactive testing
+25 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
SET ZTRTN="GUIEP^BNIRP6"
SET ZTDESC=BNIOPT
DO ^%ZTLOAD
+26 DO XIT
+27 QUIT
GUIEP ;EP - called from taskman
+1 DO PROCESS
+2 KILL ^TMP($JOB,"BNIRP6")
+3 ;cmi/maw added
SET IOM=80
+4 DO GUIR^XBLM("PRINT^BNIRP6","^TMP($J,""BNIRP6"",")
+5 SET X=0
SET C=0
FOR
SET X=$ORDER(^TMP($JOB,"BNIRP6",X))
IF X'=+X
QUIT
Begin DoDot:1
+6 SET C=C+1
+7 NEW BNIDATA
+8 SET BNIDATA=$GET(^TMP($JOB,"BNIRP6",X))
+9 IF BNIDATA="ZZZZZZZ"
SET BNIDATA=$CHAR(12)
+10 SET ^BNIGUI(BNIIEN,11,C,0)=BNIDATA
End DoDot:1
+11 SET ^BNIGUI(BNIIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
+12 SET DA=BNIIEN
SET DIK="^BNIGUI("
DO IX1^DIK
+13 DO ENDLOG
+14 SET ZTREQ="@"
+15 QUIT
+16 ;
ENDLOG ;-- write the end of the log
+1 DO NOW^%DTC
+2 SET BNINOW=$GET(%)
+3 SET DIE="^BNIGUI("
SET DA=BNIIEN
SET DR=".04////"_BNINOW_";.06///C"
+4 DO ^DIE
+5 KILL DIE,DR,DA
+6 QUIT
+7 ;
