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

BNIRP3.m

Go to the documentation of this file. 
  1. BNIRP3 ; IHS/CMI/LAB - sht 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. 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 GETDATES
  1.  S BNILIST=Y
  1. ZIS ;call to XBDBQUE
  1.  S XBRP="PRINT^BNIRP3",XBRC="PROCESS^BNIRP3",XBRX="XIT^BNIRP3",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("BNIRP3",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.  D SET
  1.  Q
  1. SET ;
  1.  I BNILIST S ^XTMP("BNIRP3",BNIJ,BNIH,"RECORDS",$P(BNIREC,U),BNIR)=""
  1.  S BNIGTOTR=BNIGTOTR+1
  1.  S BNIGTOTT=BNIGTOTT+$P(BNIREC,U,9)
  1.  S BNIPRV=$$VAL^XBDIQ1(90510,BNIR,.12)
  1.  I BNIPRV="" S BNIPRV="UNKNOWN/BLANK"
  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.  Q
  1. PRINT ;EP - called from xbdbque
  1.  S BNIGPG=0,BNIGQUIT=""
  1.  D HEADER
  1.  S BNIPRV="" F  S BNIPRV=$O(BNIGDATA(BNIPRV)) Q:BNIPRV=""!(BNIGQUIT)  D
  1.  .I $Y>(IOSL-2) D HEADER Q:BNIGQUIT
  1.  .W !,$E(BNIPRV,1,50)
  1.  .W ?55,$$C($P(BNIGDATA(BNIPRV),U,1),0,8),?68,$$C($P(BNIGDATA(BNIPRV),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("BNIRP3",BNIJ,BNIH,"RECORDS",BNID)) Q:BNID'=+BNID!(BNIGQUIT)  D
  1.  .S BNIR=0 F  S BNIR=$O(^XTMP("BNIRP3",BNIJ,BNIH,"RECORDS",BNID,BNIR)) Q:BNIR'=+BNIR!(BNIGQUIT)  D
  1.  ..I $Y>(IOSL-4) D LHDR Q:BNIGQUIT
  1.  ..W !,$$D($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("BNIRP3",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. D(D) ;EP
  1.  I D="" Q ""
  1.  Q $$FMTE^XLFDT(D)
  1.  ;
  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 Specific Health Topic  ***",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 Specific Health Topic ***",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 !,$$REPEAT^XLFSTR("-",80)
  1.  W !,?1,"SPECIFIC HEALTH TOPIC",?55,"# RECORDS",?73,"Hrs"
  1.  W !?55,"---------",?73,"---"
  1.  W !
  1.  Q
  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. INFORM ;
  1.  W:$D(IOF) @IOF
  1.  W !!,$$CTR($$LOC)
  1.  W !!,$$CTR("TIME SPENT BY SPECIFIC HEALTH TOPIC")
  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) ;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.  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="Specific Health Topic"
  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^BNIRP3",ZTDESC=BNIOPT D ^%ZTLOAD
  1.  D XIT
  1.  Q
  1. GUIEP ;EP - called from taskman
  1.  D PROCESS
  1.  K ^TMP($J,"BNIRP3")
  1.  S IOM=80  ;cmi/maw added
  1.  D GUIR^XBLM("PRINT^BNIRP2","^TMP($J,""BNIRP3"",")
  1.  S X=0,C=0 F  S X=$O(^TMP($J,"BNIRP3",X)) Q:X'=+X  D
  1.  . S C=C+1
  1.  . N BNIDATA
  1.  . S BNIDATA=$G(^TMP($J,"BNIRP3",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.  ;