Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BNIRP1

BNIRP1.m

Go to the documentation of this file. 
  1. BNIRP1 ; IHS/CMI/LAB - person report ;
  1.  ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
  1.  ;
  1. START ; 
  1.  D INFORM
  1. GETDATES ;
  1. BD ;get beginning date
  1.  W !
  1.  S BNIGBD=""
  1.  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."
  1.  KILL DA D ^DIR KILL DIR
  1.  Q:$D(DIRUT)
  1.  Q:X=""
  1.  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
  1.  K %DT S X=Y,%DT="EP" D ^%DT
  1.  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
  1.  I Y>DT W !!,"No future dates allowed!",! G BD
  1.  S BNIGBD=Y
  1. ED ;get ending date
  1.  W !
  1.  S BNIGED=""
  1.  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."
  1.  KILL DA D ^DIR KILL DIR
  1.  Q:$D(DIRUT)
  1.  Q:X=""
  1.  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
  1.  K %DT S X=Y,%DT="EP" D ^%DT
  1.  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
  1.  I Y>DT W !!,"No future dates allowed!",! G ED
  1.  S BNIGED=Y
  1.  S BNIGBDD=$$FMTE^XLFDT(BNIGBD),BNIGEDD=$$FMTE^XLFDT(BNIGED)
  1.  S X1=BNIGBD,X2=-1 D C^%DTC S BNIGSD=X
  1.  ;
  1. PROV ;
  1.  S BNIGQUIT=""
  1.  S BNIGPRVT="" K BNIGPRVS
  1.  K DIR
  1.  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
  1.  I $D(DIRUT) G GETDATES
  1.  S BNIGPRVT=Y
  1.  D @(BNIGPRVT_"PRV")
  1.  I BNIGQUIT K BNIGPRVT,BNIGPRVS G PROV
  1. SUB ;
  1.  K BNIGSUB
  1.  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"
  1.  S DIR(0)=DIR(0)_";D:by DATE of ACTIVITY;N:NO sub totals (None of the above)"
  1.  S DIR("A")="How would you like to Sub Total the report",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G PROV
  1.  S BNIGSUB=Y
  1. LIST ;
  1.  K BNILIST
  1.  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
  1.  I $D(DIRUT) G SUB
  1.  S BNILIST=Y
  1. ZIS ;call to XBDBQUE
  1.  S XBRP="PRINT^BNIRP1",XBRC="PROCESS^BNIRP1",XBRX="XIT^BNIRP1",XBNS="BNIG"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  Q
  1. PROCESS ;EP - called from xbdbque
  1.  S BNIJ=$J,BNIH=$H,BNIGTOTR=0,BNIGTOTT=0
  1.  K BNIGDATA
  1.  S ^XTMP("BNIRP1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BNI CPHAD ACTIVITY REPORT"
  1.  S BNIGSD=BNIGSD_".9999"
  1.  F  S BNIGSD=$O(^BNIREC("B",BNIGSD)) Q:BNIGSD=""!($E(BNIGSD,1,5)>$E(BNIGED,1,5))  D
  1.  .S BNIR=0 F  S BNIR=$O(^BNIREC("B",BNIGSD,BNIR)) Q:BNIR'=+BNIR  D PROC1
  1.  .Q
  1.  Q
  1. PROC1 ;
  1.  S BNIREC=$G(^BNIREC(BNIR,0))
  1.  Q:BNIREC=""
  1.  S BNIPRV=$P(BNIREC,U,8)
  1.  Q:BNIPRV=""  ;no provider entered????
  1.  I BNIGPRVT="D" D DISC Q
  1.  I $D(BNIGPRVS),'$D(BNIGPRVS(BNIPRV)) Q  ;not a provider of interest for this run
  1.  D SET
  1.  Q
  1. DISC ;
  1.  S BNIPRV=$$VALI^XBDIQ1(200,BNIPRV,53.5) Q:BNIPRV=""
  1.  I $D(BNIGPRVS),'$D(BNIGPRVS(BNIPRV)) Q
  1.  D SET
  1.  Q
  1. SET ;
  1.  I BNILIST S ^XTMP("BNIRP1",BNIJ,BNIH,"RECORDS",$P(BNIREC,U),BNIR)=""
  1.  S BNIGTOTR=BNIGTOTR+1
  1.  S BNIGTOTT=BNIGTOTT+$P(BNIREC,U,9)
  1.  I '$D(BNIGDATA(BNIPRV)) S BNIGDATA(BNIPRV)=""
  1.  S $P(BNIGDATA(BNIPRV),U,1)=$P(BNIGDATA(BNIPRV),U,1)+1
  1.  S $P(BNIGDATA(BNIPRV),U,2)=$P(BNIGDATA(BNIPRV),U,2)+$P(BNIREC,U,9)
  1.  ;sub totals
  1.  I BNIGSUB="P" D
  1.  .S X=$$VAL^XBDIQ1(90510,BNIR,.11)
  1.  I BNIGSUB="S" D
  1.  .S X=$$VAL^XBDIQ1(90510,BNIR,.12)
  1.  I BNIGSUB="T" D
  1.  .S X=$$VAL^XBDIQ1(90510,BNIR,.13)
  1.  I BNIGSUB="E" D
  1.  .S X=$$VAL^XBDIQ1(90510,BNIR,.15)
  1.  I BNIGSUB="G" D
  1.  .S X=$$VAL^XBDIQ1(90510,BNIR,.14)
  1.  I BNIGSUB="N" Q
  1.  I BNIGSUB="R" D
  1.  .S X=$$VALI^XBDIQ1(90510,BNIR,.12)
  1.  .I X="" Q
  1.  .S X=$P(^BNISHT(X,0),U,4)
  1.  .I X="" S X="Non GPRA Element" Q
  1.  .S X=$P(^BNISHT(X,0),U)
  1.  I BNIGSUB="D" D
  1.  .S X=$P(BNIREC,U)
  1.  I X="" S X="UNKNOWN"
  1.  S $P(BNIGDATA(BNIPRV,X),U,1)=$P($G(BNIGDATA(BNIPRV,X)),U,1)+1
  1.  S $P(BNIGDATA(BNIPRV,X),U,2)=$P($G(BNIGDATA(BNIPRV,X)),U,2)+$P(BNIREC,U,9)
  1.  Q
  1. PRINT ;EP - called from xbdbque
  1.  S BNIGPG=0,BNIGQUIT=""
  1.  D HEADER
  1.  ;S BNIGDATA(1)=223456_U_423900.8733
  1.  S BNIPRV="" F  S BNIPRV=$O(BNIGDATA(BNIPRV)) Q:BNIPRV=""!(BNIGQUIT)  D
  1.  .I $Y>(IOSL-2) D HEADER Q:BNIGQUIT
  1.  .I BNIGPRVT="D" W !!,$P(^DIC(7,BNIPRV,0),U)
  1.  .I BNIGPRVT'="D" W !!,$P(^VA(200,BNIPRV,0),U)
  1.  .W ?55,$$C($P(BNIGDATA(BNIPRV),U,1),0,8),?68,$$C($P(BNIGDATA(BNIPRV),U,2),2,12)
  1.  .S BNIS="" F  S BNIS=$O(BNIGDATA(BNIPRV,BNIS)) Q:BNIS=""!(BNIGQUIT)  D
  1.  ..I $Y>(IOSL-2) D HEADER Q:BNIGQUIT
  1.  ..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)
  1.  I $Y>(IOSL-4) D HEADER Q:BNIGQUIT
  1.  W !!!,"GRAND TOTALS:",?55,$$C(BNIGTOTR,0,8),?68,$$C(BNIGTOTT,2,12)
  1.  I BNILIST D LISTP
  1.  W ! D EOP
  1.  Q
  1. LISTP ;
  1.  D LHDR
  1.  S BNID=0 F  S BNID=$O(^XTMP("BNIRP1",BNIJ,BNIH,"RECORDS",BNID)) Q:BNID'=+BNID!(BNIGQUIT)  D
  1.  .S BNIR=0 F  S BNIR=$O(^XTMP("BNIRP1",BNIJ,BNIH,"RECORDS",BNID,BNIR)) Q:BNIR'=+BNIR!(BNIGQUIT)  D
  1.  ..I $Y>(IOSL-4) D LHDR Q:BNIGQUIT
  1.  ..W !,$$DT($P(^BNIREC(BNIR,0),U)),?13,$E($$VAL^XBDIQ1(90510,BNIR,.08),1,15),?30,$P(^BNIREC(BNIR,0),U,9)
  1.  ..W ?37,$E($$VAL^XBDIQ1(90510,BNIR,.15),1,20),?59,$E($$VAL^XBDIQ1(90510,BNIR,.13),1,15),?75,$$GPRA(BNIR)
  1.  ..W !?3,$$VAL^XBDIQ1(90510,BNIR,.11)
  1.  ..W !?3,$$VAL^XBDIQ1(90510,BNIR,.12)
  1.  ..Q:'$O(^BNIREC(BNIR,14,0))
  1.  ..S BNIX=0 F  S BNIX=$O(^BNIREC(BNIR,14,BNIX)) Q:BNIX'=+BNIX!(BNIGQUIT)  D
  1.  ...I $Y>(IOSL-4) D LHDR Q:BNIGQUIT
  1.  ...W !?1,^BNIREC(BNIR,14,BNIX,0)
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  K ^XTMP("BNIRP1",BNIJ,BNIH)
  1.  Q
  1. GPRA(R) ;
  1.  S X=$$VALI^XBDIQ1(90510,BNIR,.12)
  1.  I X="" Q ""
  1.  I $P(^BNISHT(X,0),U,4) Q "GPRA"
  1.  Q ""
  1. DATE(D) ;EP
  1.  I D="" Q ""
  1.  ;Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+$E(D,1,3))
  1.  Q $$FMTE^XLFDT(D)
  1.  ;
  1. DT(D) ;EP
  1.  I D="" Q ""
  1.  Q $$FMTE^XLFDT(D)
  1.  ;
  1. C(X,X2,X3) ;
  1.  D COMMA^%DTC
  1.  Q X
  1. LHDR ;
  1.  I 'BNIGPG G LHDR1
  1.  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
  1. LHDR1 ;
  1.  W:$D(IOF) @IOF S BNIGPG=BNIGPG+1
  1.  I $G(BNIGUI) W "ZZZZZZZ",!  ;maw
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BNIGPG,!
  1.  W !,$$CTR("*** Computerized Public Health Actvity Datasystem ***",80)
  1.  W !,$$CTR("*** Activity Time by Person Performing Activity ***",80)
  1.  W !,$$CTR("*** Record Listing ***",80)
  1.  W !,$$CTR($P(^DIC(4,DUZ(2),0),U),80)
  1.  S X="Activity Dates: "_$$FMTE^XLFDT(BNIGBD)_" to "_$$FMTE^XLFDT(BNIGED) W !,$$CTR(X,80)
  1.  W !!,"DATE",?10,"PROVIDER",?30,"Hrs",?37,"SETTING",?59,"ACTIVITY",?75,"GPRA"
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  W !
  1.  Q
  1.  I 'BNIGPG G HEAD1
  1.  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
  1. HEAD1 ;
  1.  W:$D(IOF) @IOF S BNIGPG=BNIGPG+1
  1.  ;I $G(BNIGUI) W "ZZZZZZZ",!  ;maw
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BNIGPG,!
  1.  W !,$$CTR("*** Computerized Public Health Actvity Datasystem  ***",80)
  1.  W !,$$CTR("***  Activity Time by Person Performing Activity  ***",80)
  1.  W !,$$CTR($P(^DIC(4,DUZ(2),0),U),80)
  1.  S X="Activity Dates: "_$$FMTE^XLFDT(BNIGBD)_" to "_$$FMTE^XLFDT(BNIGED) W !,$$CTR(X,80)
  1.  I BNIGSUB'="N" S X="Subtotalled by: " S Y=$T(@BNIGSUB) W !,$$CTR(X_$P(Y,";;",2),80)
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  W !?55,"# RECORDS",?73,"Hrs"
  1.  W !?55,"---------",?73,"---"
  1.  W !
  1.  Q
  1. P ;;PUBLIC HEALTH CONCERN
  1. S ;;SPECIFIC HEALTH TOPIC
  1. T ;;TYPE OF ACTIVITY
  1. E ;;ACTIVITY SETTING
  1. G ;;GROUP SERVED
  1. R ;;GPRA ELEMENT
  1. D ;;DATE OF ACTIVITY
  1.  ;
  1. XIT ;
  1.  D EN^XBVK("BNI")
  1.  K X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M
  1.  Q
  1. OPRV ;one provider
  1.  K DIC S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Enter PROVIDER: " D ^DIC
  1.  I Y=-1 S BNIGQUIT=1 K BNIGPRVS Q
  1.  S BNIGPRVS(+Y)=""
  1.  Q
  1. APRV ;all providers
  1.  K BNIGPRVS
  1.  Q
  1. TPRV ;taxonomy of providers
  1.  K BNIGPRVS
  1.  W !!,"At the prompt enter provider names or enter a taxonomy by ",!,"prefacing the taxonomy name with a '[' e.g. [LAM PROVIDERS",!
  1.  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
  1.  D ^AMQQGTX0(+Y,"BNIGPRVS(")
  1.  I '$D(BNIGPRVS) G PROV
  1.  I $D(BNIGPRVS("*")) K BNIGPROV Q
  1.  Q
  1. DPRV ;discipline
  1.  W !!,"At the prompt enter provider disciplines or enter a taxonomy of disciplines",!,"by prefacing the taxonomy name with a '[' e.g. [LAM PHYSICIANS.",!
  1.  K BNIGDISP,BNIGPRVS
  1.  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
  1.  D ^AMQQGTX0(+Y,"BNIGPRVS(")
  1.  I '$D(BNIGPRVS) S BNIGQUIT=1 K BNIGPRVS,BNIGDISP Q
  1.  I $D(BNIGPRVS("*")) W !!,"All providers will be included." K BNIGPRVS,BNIGDISP Q
  1.  ;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)=""
  1.  K BNIGDISP
  1.  Q
  1. INFORM ;
  1.  W:$D(IOF) @IOF
  1.  W !!,$$CTR($$LOC)
  1.  W !!,$$CTR("TIME SPENT BY PERSON PERFORMING ACTIVITY")
  1.  W !!,"This report will tally up all time spent by the person performing"
  1.  W !,"the activity.  You can optionally subtotal by other data elements."
  1.  W !
  1.  Q
  1.  ;
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)!$D(IO("S"))
  1.  NEW DIR
  1.  K DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR(0)="E" D ^DIR KILL DIR
  1.  Q
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------
  1.  ;
  1. BNIG(BNIERR,BNIJOB,BNIBTH,BNIGBD,BNIGED,BNILIST,BNIRDT,BNIGPRVT,BNIGSUB,BNIGPRVS) ;PEP - gui call
  1.  I $G(BNIJOB)="" S BNIIEN=-1 Q
  1.  I $G(BNIBTH)="" S BNIIEN=-1 Q
  1.  I $G(BNIBG)="" S BNIIEN=-1 Q
  1.  I $G(BNIED)="" S BNIIEN=-1 Q
  1.  I $G(BNILIST)="" S BNIIEN=-1 Q
  1.  I BNIGPRVT="A" K BNIGPRVS
  1.  I BNIGPRVT="TP" K BNIGTAXZ M BNIGTAXZ=BNIGPRVS K BNIGPRVS D
  1.  .NEW X,Y
  1.  .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)=""
  1.  I BNIGPRVT="DT" K BNIGTAXZ M BNIGTAXZ=BNIGPRVS K BNIGPRVS D
  1.  .NEW X,Y,Z
  1.  .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
  1.  ..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)=""
  1.  S BNIGBDD=$$FMTE^XLFDT(BNIGBD),BNIGEDD=$$FMTE^XLFDT(BNIGED)
  1.  S X1=BNIBG,X2=-1 D C^%DTC S BNIGSD=X
  1.  ;create entry in fileman file to hold output
  1.  N BNIOPT  ;maw
  1.  S BNIOPT="Time Spent by Persons Performing Activity"
  1.  D NOW^%DTC
  1.  S BNINOW=$G(%)
  1.  K DD,D0,DIC
  1.  S X=BNIJOB_"."_BNIBTH
  1.  S DIC("DR")=".02////"_DUZ_";.03////"_BNINOW_";.05////"_$G(BNIOPT)_";.06///R;.07///R"
  1.  S DIC="^BNIGUI(",DIC(0)="L",DIADD=1,DLAYGO=90512.08
  1.  D FILE^DICN
  1.  K DIADD,DLAYGO,DIC,DA
  1.  I Y=-1 S BNIIEN=-1 Q
  1.  S BNIIEN=+Y
  1.  S BNIGIEN=BNIIEN  ;cmi/maw added
  1.  D ^XBFMK
  1.  K ZTSAVE S ZTSAVE("*")=""
  1.  ;D GUIEP ;for interactive testing
  1.  S ZTIO="",ZTDTH=$$NOW^XLFDT,ZTRTN="GUIEP^BNIRP1",ZTDESC="BNI Persons Performing Activity" D ^%ZTLOAD
  1.  D XIT
  1.  Q
  1. GUIEP ;EP - called from taskman
  1.  D PROCESS
  1.  K ^TMP($J,"BNIRP1")
  1.  S IOM=80  ;cmi/maw added
  1.  D GUIR^XBLM("PRINT^BNIRP1","^TMP($J,""BNIRP1"",")
  1.  S X=0,C=0 F  S X=$O(^TMP($J,"BNIRP1",X)) Q:X'=+X  D
  1.  . S C=C+1
  1.  . N BNIDATA
  1.  . S BNIDATA=$G(^TMP($J,"BNIRP1",X))
  1.  . I BNIDATA="ZZZZZZZ" S BNIDATA=$C(12)
  1.  . S ^BNIGUI(BNIIEN,11,C,0)=BNIDATA
  1.  S ^BNIGUI(BNIIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
  1.  S DA=BNIIEN,DIK="^BNIGUI(" D IX1^DIK
  1.  D ENDLOG
  1.  S ZTREQ="@"
  1.  Q
  1.  ;
  1. ENDLOG ;-- write the end of the log
  1.  D NOW^%DTC
  1.  S BNINOW=$G(%)
  1.  S DIE="^BNIGUI(",DA=BNIIEN,DR=".04////"_BNINOW_";.06///C"
  1.  D ^DIE
  1.  K DIE,DR,DA
  1.  Q
  1.  ;