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

BNIGVL.m

Go to the documentation of this file. 
  1. BNIGVL ; IHS/CMI/LAB - bni general retrieval ;
  1.  ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006
  1.  ;visit general retrieval
  1. START ; 
  1.  K BNIGQUIT,BNIGDTR
  1.  D XIT
  1.  D INFORM
  1.  S BNIGPTVS="R"
  1. TYPE ;--- get type of report
  1.  S (BNIGPCNT,BNIGPTCT)=0
  1.  K BNIGTYPE ;--- just in case variable left around
  1.  S BNIGTYPE="RS"
  1.  D @BNIGTYPE,XIT
  1.  Q
  1. RS ;
  1.  S BNIIOSL=$S($G(BNIGUI):55,1:$G(IOSL))
  1. GETDATES ;
  1.  S BNIGLHDR="DATE RANGE SELECTION" W !!?((80-$L(BNIGLHDR))/2),BNIGLHDR
  1. GETDATE1 ;
  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.  Q:$D(BNIGDTR)
  1.  D ADD I $D(BNIGQUIT) D DEL K BNIGQUIT G RS
  1.  I '$D(BNIGCAND) D D1 Q
  1.  D TITLE I $D(BNIGQUIT) K BNIGQUIT G TYPE
  1.  D ZIS
  1.  Q
  1. D1 ;if visit, no prev defined report used
  1. D11 K ^BNIRTMP(BNIGRPT,11) D SCREEN I $D(BNIGQUIT) K BNIGQUIT D DEL G RS
  1. D12 K ^BNIRTMP(BNIGRPT,12) S BNIGTCW=0 D COUNT I $D(BNIGQUIT) K BNIGQUIT G D11
  1. D13 D TITLE I $D(BNIGQUIT) K BNIGQUIT G D12
  1.  D SAVE,ZIS
  1.  Q
  1. SCREEN ;
  1.  S BNIGCNTL="S"
  1.  D ^BNIGVL4
  1.  Q
  1. COUNT ;count only or detailed report
  1. BN D COUNT^BNIGVL3
  1.  Q
  1. TITLE ;
  1.  D TITLE^BNIGVL3
  1.  Q
  1. SAVE ;
  1.  D SAVE^BNIGVL3
  1.  Q
  1. ZIS ;call to XBDBQUE
  1.  K BNIGOPT
  1.  I 'BNIGTCW S BNIGTCW=IOM
  1.  S BNIGDONE=""
  1.  D SHOW^BNIGVLS,SHOWP^BNIGVLS,SHOWR^BNIGVLS
  1.  D XIT1
  1.  I BNIGCTYP="D"!(BNIGCTYP="S") D
  1.  .S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR
  1.  .I $D(DIRUT) S BNIGQUIT="" Q
  1.  .S BNIGOPT=Y
  1.  G:$G(BNIGQUIT) SAVE
  1.  I $G(BNIGOPT)="B" D BROWSE,XIT Q
  1.  S XBRP="^BNIGVLP",XBRC="^BNIGVL1",XBRX="XIT^BNIGVL",XBNS="BNIG"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  Q
  1. DEL ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT
  1.  I $G(BNIGRPT),$D(^BNIRTMP(BNIGRPT,0)),'$P(^BNIRTMP(BNIGRPT,0),U,2) S DIK="^BNIRTMP(",DA=BNIGRPT D ^DIK K DIK,DA,DIC
  1.  Q
  1. BROWSE ;
  1.  S XBRP="VIEWR^XBLM(""^BNIGVLP"")"
  1.  S XBRC="^BNIGVL1",XBRX="XIT^BNIGVL",XBIOP=0 D ^XBDBQUE
  1.  Q
  1. XIT ;
  1.  D XIT^BNIGVL1
  1. XIT1 ;
  1.  D XIT1^BNIGVL1
  1.  Q
  1. ADD ;EP
  1.  K BNIGCAND
  1.  W !!
  1.  I $D(BNIGNCAN) G ADD1
  1.  I $D(BNIGSEAT),'$D(BNIGEP1) G ADD1
  1.  S DIR(0)="Y",DIR("A")="Do you want to use a PREVIOUSLY DEFINED REPORT",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) S BNIGQUIT=1 Q
  1.  I 'Y G ADD1
  1.  S DIC="^BNIRTMP(",DIC("S")="I $P(^(0),U,2)&($P(^(0),U,6)=BNIGPTVS)" S:$D(BNIGEP1) DIC("S")=DIC("S")_"&($P(^(0),U,9)=BNIGPACK)" S DIC(0)="AEQ",DIC("A")="REPORT NAME:  ",D="C" D IX^DIC K DIC,DA,DR
  1.  I Y=-1 S BNIGQUIT=1 Q
  1.  S BNIGRPT=+Y,BNIGCAND=1
  1.  ;--- set up sorting and report control variables
  1.  S BNIGSORT=$P(^BNIRTMP(BNIGRPT,0),U,7),BNIGSORV=$P(^(0),U,8),BNIGSPAG=$P(^(0),U,4),BNIGCTYP=$P(^(0),U,5)
  1.  S X=0 F  S X=$O(^BNIRTMP(BNIGRPT,12,X)) Q:X'=+X  S BNIGTCW=BNIGTCW+$P(^BNIRTMP(BNIGRPT,12,X,0),U,2)+2
  1.  Q
  1. ADD1 ;
  1.  ;CREATE REPORT ENTRY IN FILEMAN FILE
  1.  S %H=$H D YX^%DTC S X=$P(^VA(200,DUZ,0),U)_"-"_Y,DIC(0)="L",DIC="^BNIRTMP(",DLAYGO=90512.88,DIADD=1,DIC("DR")=".13////"_DUZ D ^DIC K DIC,DA,DR,DIADD,DLAYGO I Y=-1 W !!,"UNABLE TO CREATE REPORT ENTRY - NOTIFY SITE MANAGER!" S BNIGQUIT=1 Q
  1.  S BNIGRPT=+Y
  1.  K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
  1.  ;DELETE ALL 11 MULTIPLE HERE
  1.  K ^BNIRTMP(BNIGRPT,11)
  1.  Q
  1. INFORM ;EP
  1.  S BNIGTCW=0
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR($$LOC(),80),!
  1.  W $$CTR($$USR(),80)
  1.  W !!,$$CTR("CPHAD GENERAL RETRIEVAL PROGRAM",80),!
  1.  S T="INTRO" F J=1:1 S X=$T(@T+J),X=$P(X,";;",2) Q:X="END"  W !,X
  1.  K J,X,T
  1.  Q
  1.  ;
  1. INTRO ;
  1.  ;;This is the general retrieval program for the Computerized Public
  1.  ;;Health Activity Data System (CPHAD).
  1.  ;;END
  1.   Q
  1. PAUSE ;EP
  1.  Q:$E(IOST)'="C"!(IO'=IO(0))
  1.  W ! S DIR(0)="EO",DIR("A")="Hit return to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  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)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR(0)="E" D ^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. TEST ;
  1.  D BDMG(3030101,3060601,17)
  1.  Q
  1. BDMG(BNIGBD,BNIGED,BNIGRPT,BNIGTITL) ;PEP - gui call
  1.  I $G(BNIGBD)="" S BNIIEN=-1 Q
  1.  I $G(BNIGED)="" S BNIIEN=-1 Q
  1.  I $G(BNIGRPT)="" S BNIIEN=-1 Q
  1.  S BNIGTITL=$G(BNIGTITL)
  1.  ;create entry in fileman file to hold output
  1.  S BNIGUI=1
  1.  N BNIOPT  ;maw
  1.  S BNIOPT="CPHAD GENERAL RETRIEVAL"
  1.  S BNIGPTVS="R"
  1.  S (BNIGPCNT,BNIGPTCT)=0
  1.  K BNIGTYPE ;--- just in case variable left around
  1.  S BNIGTYPE="RS"
  1.  S BNIGBDD=$$FMTE^XLFDT(BNIGBD),BNIGEDD=$$FMTE^XLFDT(BNIGED)
  1.  S BNIGSORT=$P(^BNIRTMP(BNIGRPT,0),U,7),BNIGSORV=$P(^(0),U,8),BNIGSPAG=$P(^(0),U,4),BNIGCTYP=$P(^(0),U,5)
  1.  I BNIGCTYP="T" S BNIGSORT=1,BNIGSORV="Activity Date"
  1.  S X=0,BNIGTCW=0 F  S X=$O(^BNIRTMP(BNIGRPT,12,X)) Q:X'=+X  S BNIGTCW=BNIGTCW+$P(^BNIRTMP(BNIGRPT,12,X,0),U,2)+2
  1.  D NOW^%DTC
  1.  S BNINOW=$G(%)
  1.  K DD,D0,DIC,DIR
  1.  S X=$J_"."_$H
  1.  S DIC("DR")=".02////"_DUZ_";.03////"_BNINOW_";.05////"_BNIOPT_";.06///R;.07///"_$S(BNIGCTYP="L":"D",1:"P")
  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 BDMGIEN=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^BNIGVL",ZTDESC="GUI CPHAD GEN RETRIEVAL" D ^%ZTLOAD
  1.  D XIT
  1.  Q
  1. GUIEP ;EP - called from taskman
  1.  D ^BNIGVL1
  1.  K ^TMP($J,"BNIGVL")
  1.  S IOM=80  ;cmi/maw added
  1.  D GUIR^XBLM("^BNIGVLP","^TMP($J,""BNIGVL"",")
  1.  Q:$G(BNIDSP)  ;quit if to screen
  1.  S X=0,C=0 F  S X=$O(^TMP($J,"BNIGVL",X)) Q:X'=+X  D
  1.  .S BNIDATA=^TMP($J,"BNIGVL",X)
  1.  .I BNIDATA="ZZZZZZZ" S BNIDATA=$C(12)
  1.  .S ^BNIGUI(BNIIEN,11,X,0)=BNIDATA,C=C+1
  1.  S ^BNIGUI(BNIIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
  1.  S DA=BNIIEN,DIK="^BNIGUI(" D IX1^DIK
  1.  D ENDLOG
  1.  K ^TMP($J,"BNIGVL")
  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.  ;