BNIRP1 ; IHS/CMI/LAB - person 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
;
PROV ;
S BNIGQUIT=""
S BNIGPRVT="" K BNIGPRVS
K DIR
S DIR(0)="S^O:ONE Provider;A:ALL Providers;T:Selected Set or TAXONOMY of Providers;D:Selected Set or Taxonomy of Provider DISCIPLINES",DIR("A")="Include which Providers",DIR("B")="O" KILL DA D ^DIR K DIR
I $D(DIRUT) G GETDATES
S BNIGPRVT=Y
D @(BNIGPRVT_"PRV")
I BNIGQUIT K BNIGPRVT,BNIGPRVS G PROV
SUB ;
K BNIGSUB
K DIR S DIR(0)="S^P:by PUBLIC HEALTH CONCERN;S:by SPECIFIC HEALTH TOPIC;T:by TYPE OF ACTIVITY;E:by ACTIVITY SETTING;G:by GROUP SERVED;R:by GPRA Elements"
S DIR(0)=DIR(0)_";D:by DATE of ACTIVITY;N:NO sub totals (None of the above)"
S DIR("A")="How would you like to Sub Total the report",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G PROV
S BNIGSUB=Y
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 SUB
S BNILIST=Y
ZIS ;call to XBDBQUE
S XBRP="PRINT^BNIRP1",XBRC="PROCESS^BNIRP1",XBRX="XIT^BNIRP1",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("BNIRP1",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 BNIPRV=$P(BNIREC,U,8)
Q:BNIPRV="" ;no provider entered????
I BNIGPRVT="D" D DISC Q
I $D(BNIGPRVS),'$D(BNIGPRVS(BNIPRV)) Q ;not a provider of interest for this run
D SET
Q
DISC ;
S BNIPRV=$$VALI^XBDIQ1(200,BNIPRV,53.5) Q:BNIPRV=""
I $D(BNIGPRVS),'$D(BNIGPRVS(BNIPRV)) Q
D SET
Q
SET ;
I BNILIST S ^XTMP("BNIRP1",BNIJ,BNIH,"RECORDS",$P(BNIREC,U),BNIR)=""
S BNIGTOTR=BNIGTOTR+1
S BNIGTOTT=BNIGTOTT+$P(BNIREC,U,9)
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)
;sub totals
I BNIGSUB="P" D
.S X=$$VAL^XBDIQ1(90510,BNIR,.11)
I BNIGSUB="S" D
.S X=$$VAL^XBDIQ1(90510,BNIR,.12)
I BNIGSUB="T" D
.S X=$$VAL^XBDIQ1(90510,BNIR,.13)
I BNIGSUB="E" D
.S X=$$VAL^XBDIQ1(90510,BNIR,.15)
I BNIGSUB="G" D
.S X=$$VAL^XBDIQ1(90510,BNIR,.14)
I BNIGSUB="N" Q
I BNIGSUB="R" D
.S X=$$VALI^XBDIQ1(90510,BNIR,.12)
.I X="" Q
.S X=$P(^BNISHT(X,0),U,4)
.I X="" S X="Non GPRA Element" Q
.S X=$P(^BNISHT(X,0),U)
I BNIGSUB="D" D
.S X=$P(BNIREC,U)
I X="" S X="UNKNOWN"
S $P(BNIGDATA(BNIPRV,X),U,1)=$P($G(BNIGDATA(BNIPRV,X)),U,1)+1
S $P(BNIGDATA(BNIPRV,X),U,2)=$P($G(BNIGDATA(BNIPRV,X)),U,2)+$P(BNIREC,U,9)
Q
PRINT ;EP - called from xbdbque
S BNIGPG=0,BNIGQUIT=""
D HEADER
;S BNIGDATA(1)=223456_U_423900.8733
S BNIPRV="" F S BNIPRV=$O(BNIGDATA(BNIPRV)) Q:BNIPRV=""!(BNIGQUIT) D
.I $Y>(IOSL-2) D HEADER Q:BNIGQUIT
.I BNIGPRVT="D" W !!,$P(^DIC(7,BNIPRV,0),U)
.I BNIGPRVT'="D" W !!,$P(^VA(200,BNIPRV,0),U)
.W ?55,$$C($P(BNIGDATA(BNIPRV),U,1),0,8),?68,$$C($P(BNIGDATA(BNIPRV),U,2),2,12)
.S BNIS="" F S BNIS=$O(BNIGDATA(BNIPRV,BNIS)) Q:BNIS=""!(BNIGQUIT) D
..I $Y>(IOSL-2) D HEADER Q:BNIGQUIT
..W !?2,$S(BNIGSUB="D":$$DATE(BNIS),1:$E(BNIS,1,50)),?55,$$C($P(BNIGDATA(BNIPRV,BNIS),U,1),0,8),?68,$$C($P(BNIGDATA(BNIPRV,BNIS),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("BNIRP1",BNIJ,BNIH,"RECORDS",BNID)) Q:BNID'=+BNID!(BNIGQUIT) D
.S BNIR=0 F S BNIR=$O(^XTMP("BNIRP1",BNIJ,BNIH,"RECORDS",BNID,BNIR)) Q:BNIR'=+BNIR!(BNIGQUIT) D
..I $Y>(IOSL-4) D LHDR Q:BNIGQUIT
..W !,$$DT($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("BNIRP1",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)
;
DT(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 by Person Performing Activity ***",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 by Person Performing Activity ***",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)
I BNIGSUB'="N" S X="Subtotalled by: " S Y=$T(@BNIGSUB) W !,$$CTR(X_$P(Y,";;",2),80)
W !,$$REPEAT^XLFSTR("-",80)
W !?55,"# RECORDS",?73,"Hrs"
W !?55,"---------",?73,"---"
W !
Q
P ;;PUBLIC HEALTH CONCERN
S ;;SPECIFIC HEALTH TOPIC
T ;;TYPE OF ACTIVITY
E ;;ACTIVITY SETTING
G ;;GROUP SERVED
R ;;GPRA ELEMENT
D ;;DATE OF ACTIVITY
;
XIT ;
D EN^XBVK("BNI")
K X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M
Q
OPRV ;one provider
K DIC S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Enter PROVIDER: " D ^DIC
I Y=-1 S BNIGQUIT=1 K BNIGPRVS Q
S BNIGPRVS(+Y)=""
Q
APRV ;all providers
K BNIGPRVS
Q
TPRV ;taxonomy of providers
K BNIGPRVS
W !!,"At the prompt enter provider names or enter a taxonomy by ",!,"prefacing the taxonomy name with a '[' e.g. [LAM PROVIDERS",!
S X="PRIMARY PROVIDER",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
D ^AMQQGTX0(+Y,"BNIGPRVS(")
I '$D(BNIGPRVS) G PROV
I $D(BNIGPRVS("*")) K BNIGPROV Q
Q
DPRV ;discipline
W !!,"At the prompt enter provider disciplines or enter a taxonomy of disciplines",!,"by prefacing the taxonomy name with a '[' e.g. [LAM PHYSICIANS.",!
K BNIGDISP,BNIGPRVS
S X="DISCIPLINE",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
D ^AMQQGTX0(+Y,"BNIGPRVS(")
I '$D(BNIGPRVS) S BNIGQUIT=1 K BNIGPRVS,BNIGDISP Q
I $D(BNIGPRVS("*")) W !!,"All providers will be included." K BNIGPRVS,BNIGDISP Q
;S X=0 F S X=$O(^VA(200,X)) Q:X'=+X S Y=$$VALI^XBDIQ1(200,X,53.5) I Y,$D(BNIGDISP(Y)) S BNIGPRVS(X)=""
K BNIGDISP
Q
INFORM ;
W:$D(IOF) @IOF
W !!,$$CTR($$LOC)
W !!,$$CTR("TIME SPENT BY PERSON PERFORMING ACTIVITY")
W !!,"This report will tally up all time spent by the person performing"
W !,"the activity. You can optionally subtotal by other data elements."
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,BNIGPRVT,BNIGSUB,BNIGPRVS) ;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
I BNIGPRVT="A" K BNIGPRVS
I BNIGPRVT="TP" K BNIGTAXZ M BNIGTAXZ=BNIGPRVS K BNIGPRVS D
.NEW X,Y
.S X=0 F S X=$O(BNIGTAXZ(X)) Q:X'=+X S Y=0 F S Y=$O(^ATXAX(X,21,"B",Y)) Q:Y'=+Y S BNIGPRVS(Y)=""
I BNIGPRVT="DT" K BNIGTAXZ M BNIGTAXZ=BNIGPRVS K BNIGPRVS D
.NEW X,Y,Z
.S X=0 F S X=$O(BNIGTAXZ(X)) Q:X'=+X S Y=0 F S Y=$O(^ATXAX(X,21,"B",Y)) Q:Y'=+Y D
..S Z=0 F S Z=$O(^VA(200,Z)) Q:Z'=+Z S A=$$VALI^XBDIQ1(200,Z,53.5) I A=Y S BNIGPRVS(Z)=""
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="Time Spent by Persons Performing Activity"
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^BNIRP1",ZTDESC="BNI Persons Performing Activity" D ^%ZTLOAD
D XIT
Q
GUIEP ;EP - called from taskman
D PROCESS
K ^TMP($J,"BNIRP1")
S IOM=80 ;cmi/maw added
D GUIR^XBLM("PRINT^BNIRP1","^TMP($J,""BNIRP1"",")
S X=0,C=0 F S X=$O(^TMP($J,"BNIRP1",X)) Q:X'=+X D
. S C=C+1
. N BNIDATA
. S BNIDATA=$G(^TMP($J,"BNIRP1",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
;
BNIRP1 ; IHS/CMI/LAB - person 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 ;
PROV ;
+1 SET BNIGQUIT=""
+2 SET BNIGPRVT=""
KILL BNIGPRVS
+3 KILL DIR
+4 SET DIR(0)="S^O:ONE Provider;A:ALL Providers;T:Selected Set or TAXONOMY of Providers;D:Selected Set or Taxonomy of Provider DISCIPLINES"
SET DIR("A")="Include which Providers"
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO GETDATES
+6 SET BNIGPRVT=Y
+7 DO @(BNIGPRVT_"PRV")
+8 IF BNIGQUIT
KILL BNIGPRVT,BNIGPRVS
GOTO PROV
SUB ;
+1 KILL BNIGSUB
+2 KILL DIR
SET DIR(0)="S^P:by PUBLIC HEALTH CONCERN;S:by SPECIFIC HEALTH TOPIC;T:by TYPE OF ACTIVITY;E:by ACTIVITY SETTING;G:by GROUP SERVED;R:by GPRA Elements"
+3 SET DIR(0)=DIR(0)_";D:by DATE of ACTIVITY;N:NO sub totals (None of the above)"
+4 SET DIR("A")="How would you like to Sub Total the report"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO PROV
+6 SET BNIGSUB=Y
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 SUB
+4 SET BNILIST=Y
ZIS ;call to XBDBQUE
+1 SET XBRP="PRINT^BNIRP1"
SET XBRC="PROCESS^BNIRP1"
SET XBRX="XIT^BNIRP1"
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("BNIRP1",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 BNIPRV=$PIECE(BNIREC,U,8)
+4 ;no provider entered????
IF BNIPRV=""
QUIT
+5 IF BNIGPRVT="D"
DO DISC
QUIT
+6 ;not a provider of interest for this run
IF $DATA(BNIGPRVS)
IF '$DATA(BNIGPRVS(BNIPRV))
QUIT
+7 DO SET
+8 QUIT
DISC ;
+1 SET BNIPRV=$$VALI^XBDIQ1(200,BNIPRV,53.5)
IF BNIPRV=""
QUIT
+2 IF $DATA(BNIGPRVS)
IF '$DATA(BNIGPRVS(BNIPRV))
QUIT
+3 DO SET
+4 QUIT
SET ;
+1 IF BNILIST
SET ^XTMP("BNIRP1",BNIJ,BNIH,"RECORDS",$PIECE(BNIREC,U),BNIR)=""
+2 SET BNIGTOTR=BNIGTOTR+1
+3 SET BNIGTOTT=BNIGTOTT+$PIECE(BNIREC,U,9)
+4 IF '$DATA(BNIGDATA(BNIPRV))
SET BNIGDATA(BNIPRV)=""
+5 SET $PIECE(BNIGDATA(BNIPRV),U,1)=$PIECE(BNIGDATA(BNIPRV),U,1)+1
+6 SET $PIECE(BNIGDATA(BNIPRV),U,2)=$PIECE(BNIGDATA(BNIPRV),U,2)+$PIECE(BNIREC,U,9)
+7 ;sub totals
+8 IF BNIGSUB="P"
Begin DoDot:1
+9 SET X=$$VAL^XBDIQ1(90510,BNIR,.11)
End DoDot:1
+10 IF BNIGSUB="S"
Begin DoDot:1
+11 SET X=$$VAL^XBDIQ1(90510,BNIR,.12)
End DoDot:1
+12 IF BNIGSUB="T"
Begin DoDot:1
+13 SET X=$$VAL^XBDIQ1(90510,BNIR,.13)
End DoDot:1
+14 IF BNIGSUB="E"
Begin DoDot:1
+15 SET X=$$VAL^XBDIQ1(90510,BNIR,.15)
End DoDot:1
+16 IF BNIGSUB="G"
Begin DoDot:1
+17 SET X=$$VAL^XBDIQ1(90510,BNIR,.14)
End DoDot:1
+18 IF BNIGSUB="N"
QUIT
+19 IF BNIGSUB="R"
Begin DoDot:1
+20 SET X=$$VALI^XBDIQ1(90510,BNIR,.12)
+21 IF X=""
QUIT
+22 SET X=$PIECE(^BNISHT(X,0),U,4)
+23 IF X=""
SET X="Non GPRA Element"
QUIT
+24 SET X=$PIECE(^BNISHT(X,0),U)
End DoDot:1
+25 IF BNIGSUB="D"
Begin DoDot:1
+26 SET X=$PIECE(BNIREC,U)
End DoDot:1
+27 IF X=""
SET X="UNKNOWN"
+28 SET $PIECE(BNIGDATA(BNIPRV,X),U,1)=$PIECE($GET(BNIGDATA(BNIPRV,X)),U,1)+1
+29 SET $PIECE(BNIGDATA(BNIPRV,X),U,2)=$PIECE($GET(BNIGDATA(BNIPRV,X)),U,2)+$PIECE(BNIREC,U,9)
+30 QUIT
PRINT ;EP - called from xbdbque
+1 SET BNIGPG=0
SET BNIGQUIT=""
+2 DO HEADER
+3 ;S BNIGDATA(1)=223456_U_423900.8733
+4 SET BNIPRV=""
FOR
SET BNIPRV=$ORDER(BNIGDATA(BNIPRV))
IF BNIPRV=""!(BNIGQUIT)
QUIT
Begin DoDot:1
+5 IF $Y>(IOSL-2)
DO HEADER
IF BNIGQUIT
QUIT
+6 IF BNIGPRVT="D"
WRITE !!,$PIECE(^DIC(7,BNIPRV,0),U)
+7 IF BNIGPRVT'="D"
WRITE !!,$PIECE(^VA(200,BNIPRV,0),U)
+8 WRITE ?55,$$C($PIECE(BNIGDATA(BNIPRV),U,1),0,8),?68,$$C($PIECE(BNIGDATA(BNIPRV),U,2),2,12)
+9 SET BNIS=""
FOR
SET BNIS=$ORDER(BNIGDATA(BNIPRV,BNIS))
IF BNIS=""!(BNIGQUIT)
QUIT
Begin DoDot:2
+10 IF $Y>(IOSL-2)
DO HEADER
IF BNIGQUIT
QUIT
+11 WRITE !?2,$SELECT(BNIGSUB="D":$$DATE(BNIS),1:$EXTRACT(BNIS,1,50)),?55,$$C($PIECE(BNIGDATA(BNIPRV,BNIS),U,1),0,8),?68,$$C($PIECE(BNIGDATA(BNIPRV,BNIS),U,2),2,12)
End DoDot:2
End DoDot:1
+12 IF $Y>(IOSL-4)
DO HEADER
IF BNIGQUIT
QUIT
+13 WRITE !!!,"GRAND TOTALS:",?55,$$C(BNIGTOTR,0,8),?68,$$C(BNIGTOTT,2,12)
+14 IF BNILIST
DO LISTP
+15 WRITE !
DO EOP
+16 QUIT
LISTP ;
+1 DO LHDR
+2 SET BNID=0
FOR
SET BNID=$ORDER(^XTMP("BNIRP1",BNIJ,BNIH,"RECORDS",BNID))
IF BNID'=+BNID!(BNIGQUIT)
QUIT
Begin DoDot:1
+3 SET BNIR=0
FOR
SET BNIR=$ORDER(^XTMP("BNIRP1",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 !,$$DT($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("BNIRP1",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 ;
DT(D) ;EP
+1 IF D=""
QUIT ""
+2 QUIT $$FMTE^XLFDT(D)
+3 ;
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 by Person Performing Activity ***",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 by Person Performing Activity ***",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 IF BNIGSUB'="N"
SET X="Subtotalled by: "
SET Y=$TEXT(@BNIGSUB)
WRITE !,$$CTR(X_$PIECE(Y,";;",2),80)
+9 WRITE !,$$REPEAT^XLFSTR("-",80)
+10 WRITE !?55,"# RECORDS",?73,"Hrs"
+11 WRITE !?55,"---------",?73,"---"
+12 WRITE !
+13 QUIT
P ;;PUBLIC HEALTH CONCERN
S ;;SPECIFIC HEALTH TOPIC
T ;;TYPE OF ACTIVITY
E ;;ACTIVITY SETTING
G ;;GROUP SERVED
R ;;GPRA ELEMENT
D ;;DATE OF ACTIVITY
+1 ;
XIT ;
+1 DO EN^XBVK("BNI")
+2 KILL X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M
+3 QUIT
OPRV ;one provider
+1 KILL DIC
SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter PROVIDER: "
DO ^DIC
+2 IF Y=-1
SET BNIGQUIT=1
KILL BNIGPRVS
QUIT
+3 SET BNIGPRVS(+Y)=""
+4 QUIT
APRV ;all providers
+1 KILL BNIGPRVS
+2 QUIT
TPRV ;taxonomy of providers
+1 KILL BNIGPRVS
+2 WRITE !!,"At the prompt enter provider names or enter a taxonomy by ",!,"prefacing the taxonomy name with a '[' e.g. [LAM PROVIDERS",!
+3 SET X="PRIMARY PROVIDER"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
GOTO XIT
+4 DO ^AMQQGTX0(+Y,"BNIGPRVS(")
+5 IF '$DATA(BNIGPRVS)
GOTO PROV
+6 IF $DATA(BNIGPRVS("*"))
KILL BNIGPROV
QUIT
+7 QUIT
DPRV ;discipline
+1 WRITE !!,"At the prompt enter provider disciplines or enter a taxonomy of disciplines",!,"by prefacing the taxonomy name with a '[' e.g. [LAM PHYSICIANS.",!
+2 KILL BNIGDISP,BNIGPRVS
+3 SET X="DISCIPLINE"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
GOTO XIT
+4 DO ^AMQQGTX0(+Y,"BNIGPRVS(")
+5 IF '$DATA(BNIGPRVS)
SET BNIGQUIT=1
KILL BNIGPRVS,BNIGDISP
QUIT
+6 IF $DATA(BNIGPRVS("*"))
WRITE !!,"All providers will be included."
KILL BNIGPRVS,BNIGDISP
QUIT
+7 ;S X=0 F S X=$O(^VA(200,X)) Q:X'=+X S Y=$$VALI^XBDIQ1(200,X,53.5) I Y,$D(BNIGDISP(Y)) S BNIGPRVS(X)=""
+8 KILL BNIGDISP
+9 QUIT
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!,$$CTR($$LOC)
+3 WRITE !!,$$CTR("TIME SPENT BY PERSON PERFORMING ACTIVITY")
+4 WRITE !!,"This report will tally up all time spent by the person performing"
+5 WRITE !,"the activity. You can optionally subtotal by other data elements."
+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,BNIGPRVT,BNIGSUB,BNIGPRVS) ;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 IF BNIGPRVT="A"
KILL BNIGPRVS
+7 IF BNIGPRVT="TP"
KILL BNIGTAXZ
MERGE BNIGTAXZ=BNIGPRVS
KILL BNIGPRVS
Begin DoDot:1
+8 NEW X,Y
+9 SET X=0
FOR
SET X=$ORDER(BNIGTAXZ(X))
IF X'=+X
QUIT
SET Y=0
FOR
SET Y=$ORDER(^ATXAX(X,21,"B",Y))
IF Y'=+Y
QUIT
SET BNIGPRVS(Y)=""
End DoDot:1
+10 IF BNIGPRVT="DT"
KILL BNIGTAXZ
MERGE BNIGTAXZ=BNIGPRVS
KILL BNIGPRVS
Begin DoDot:1
+11 NEW X,Y,Z
+12 SET X=0
FOR
SET X=$ORDER(BNIGTAXZ(X))
IF X'=+X
QUIT
SET Y=0
FOR
SET Y=$ORDER(^ATXAX(X,21,"B",Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+13 SET Z=0
FOR
SET Z=$ORDER(^VA(200,Z))
IF Z'=+Z
QUIT
SET A=$$VALI^XBDIQ1(200,Z,53.5)
IF A=Y
SET BNIGPRVS(Z)=""
End DoDot:2
End DoDot:1
+14 SET BNIGBDD=$$FMTE^XLFDT(BNIGBD)
SET BNIGEDD=$$FMTE^XLFDT(BNIGED)
+15 SET X1=BNIBG
SET X2=-1
DO C^%DTC
SET BNIGSD=X
+16 ;create entry in fileman file to hold output
+17 ;maw
NEW BNIOPT
+18 SET BNIOPT="Time Spent by Persons Performing Activity"
+19 DO NOW^%DTC
+20 SET BNINOW=$GET(%)
+21 KILL DD,D0,DIC
+22 SET X=BNIJOB_"."_BNIBTH
+23 SET DIC("DR")=".02////"_DUZ_";.03////"_BNINOW_";.05////"_$GET(BNIOPT)_";.06///R;.07///R"
+24 SET DIC="^BNIGUI("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=90512.08
+25 DO FILE^DICN
+26 KILL DIADD,DLAYGO,DIC,DA
+27 IF Y=-1
SET BNIIEN=-1
QUIT
+28 SET BNIIEN=+Y
+29 ;cmi/maw added
SET BNIGIEN=BNIIEN
+30 DO ^XBFMK
+31 KILL ZTSAVE
SET ZTSAVE("*")=""
+32 ;D GUIEP ;for interactive testing
+33 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
SET ZTRTN="GUIEP^BNIRP1"
SET ZTDESC="BNI Persons Performing Activity"
DO ^%ZTLOAD
+34 DO XIT
+35 QUIT
GUIEP ;EP - called from taskman
+1 DO PROCESS
+2 KILL ^TMP($JOB,"BNIRP1")
+3 ;cmi/maw added
SET IOM=80
+4 DO GUIR^XBLM("PRINT^BNIRP1","^TMP($J,""BNIRP1"",")
+5 SET X=0
SET C=0
FOR
SET X=$ORDER(^TMP($JOB,"BNIRP1",X))
IF X'=+X
QUIT
Begin DoDot:1
+6 SET C=C+1
+7 NEW BNIDATA
+8 SET BNIDATA=$GET(^TMP($JOB,"BNIRP1",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 ;
