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

BWGRVL.m

Go to the documentation of this file. 
  1. BWGRVL ; IHS/CMI/LAB - WH VISIT GENERAL RETRIEVAL DRIVER ROUTINE ;15-Feb-2003 21:51;PLS
  1.  ;;2.0;WOMEN'S HEALTH;**6,8**;MAY 16, 1996
  1.  ;visit general retrieval
  1. START ;
  1.  K BWGRQUIT,BWGRDTR
  1.  D XIT
  1.  D INFORM
  1. RTYPE ;get report type  - patient list or procedure list
  1.  S BWGRPTVS=""
  1.  S DIR(0)="S^P:Patients (List or Count WH Patients);R:Procedures (List or Count WH Procedures)",DIR("A")="Which type of Retrieval should be done",DIR("B")="P" KILL DA D ^DIR KILL DIR
  1.  G:$D(DIRUT) XIT
  1.  S BWGRPTVS=Y
  1. TYPE ;--- get type of report (patient, date range or search template)
  1.  S (BWGRPCNT,BWGRPTCT)=0 ;BWGRPTCT -- pt total for # of "V"isits
  1.  K BWGRTYPE ;--- just in case variable left around
  1.  K DIR,X,Y
  1.  I BWGRPTVS="P" S DIR(0)="S^S:Search Template of Patients;P:Search All WH Patients",DIR("B")="P"
  1.  I BWGRPTVS="R" S DIR(0)="S^P:Search Template of Patients;S:Search All WH Procedures",DIR("B")="S"
  1.  S DIR("A")="     Select "_$S(BWGRPTVS="P":"Patient ",1:"Procedure ")_"List from" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  G:$D(DIRUT) XIT
  1.  S BWGRTYPE=BWGRPTVS_Y
  1.  D @BWGRTYPE,XIT
  1.  Q
  1. PP ;patient lister
  1.  D ADD I $D(BWGRQUIT) D DEL K BWGRQUIT G TYPE
  1.  I '$D(BWGRCAND) D PP1 Q
  1.  I $D(BWGRCAND),$P(^BWGRTRPT(BWGRRPT,0),U,11) D  I $D(DIRUT)!'($D(BWGRBDD))!('$D(BWGREDD)) Q
  1.  .S BWGRDTR=""
  1.  .W !!,"You have selected at least one item that requires a date range selection."
  1.  .D GETDATE1
  1.  D TITLE I $D(BWGRQUIT) K BWGRQUIT G TYPE
  1.  D ZIS
  1.  Q
  1. PP1 ;if patient, no prev defined report used
  1. PP11 K ^BWGRTRPT(BWGRRPT,11) D SCREEN I $D(BWGRQUIT) K BWGRQUIT D DEL G TYPE
  1.  I $D(BWGRDTR) D
  1.  .W !!,"You have selected at least one item that requires a date range selection."
  1.  .D GETDATE1
  1.  .I '$D(BWGRBDD)!('$D(BWGREDD))!($D(DIRUT)) G PP11
  1. PP12 K ^BWGRTRPT(BWGRRPT,12) S BWGRTCW=0 D COUNT I $D(BWGRQUIT) K BWGRQUIT G PP11
  1. PP13 D TITLE I $D(BWGRQUIT) K BWGRQUIT G PP12
  1.  D SAVE,ZIS
  1.  Q
  1. PS ;--- process report when search template used
  1.  Q:$D(BWGRQMAN)
  1.  D PS0
  1.  Q:$D(BWGRQUIT)
  1. PS1 ;EP
  1.  D ADD I $D(BWGRQUIT) G PS
  1. PS12 K ^BWGRTRPT(BWGRRPT,12) S BWGRTCW=0 D COUNT I $D(BWGRQUIT) K BWGRQUIT G PS
  1. PS13 D TITLE I $D(BWGRQUIT) K BWGRQUIT G PS12
  1.  D ZIS
  1.  Q
  1. PS0 ;
  1.  S DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)" S DIC="^DIBT(",DIC("A")="Enter Patient SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
  1.  I Y=-1 S BWGRQUIT="" Q
  1.  S BWGRSEAT=+Y
  1.  Q
  1. RP ;visit/pt search template
  1.  W ! S DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)" S DIC="^DIBT(",DIC("A")="Enter Patient SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
  1.  I Y=-1 S BWGRQUIT="" Q
  1.  S BWGRSEAT=+Y
  1.  G RS
  1.  Q
  1. RS ;
  1. GETDATES ;
  1.  S BWGRLHDR="DATE RANGE SELECTION" W !!?((80-$L(BWGRLHDR))/2),BWGRLHDR
  1.  W !!,"This is a required response.  Remember, if you are using a Search Template of",!,"WH Procedures, the Date Range entered here must correspond to the date range"
  1.  W !,"used to generate the template or be a subset of that date range.",!
  1. GETDATE1 ;
  1. BD ;get beginning date
  1.  W ! K DIR,X,Y S DIR(0)="D^:DT:EP",DIR("A")="Enter Beginning Visit Date for search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) D DEL Q
  1.  S BWGRBD=Y
  1. ED ;get ending date
  1.  W ! K DIR,X,Y S DIR(0)="DA^"_BWGRBD_":DT:EP",DIR("A")="Enter Ending Visit Date for search: " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) G BD
  1.  G:Y="" BD
  1.  S BWGRED=Y
  1.  S X1=BWGRBD,X2=-1 D C^%DTC S BWGRD=X S Y=BWGRBD D DD^%DT S BWGRBDD=Y S Y=BWGRED D DD^%DT S BWGREDD=Y
  1.  Q:$D(BWGRDTR)
  1.  D ADD I $D(BWGRQUIT) D DEL K BWGRQUIT G RS
  1.  I '$D(BWGRCAND) D D1 Q
  1.  D TITLE I $D(BWGRQUIT) K BWGRQUIT G TYPE
  1.  D ZIS
  1.  Q
  1. D1 ;if visit, no prev defined report used
  1. D11 K ^BWGRTRPT(BWGRRPT,11) D SCREEN I $D(BWGRQUIT) K BWGRQUIT D DEL G RS
  1. D12 K ^BWGRTRPT(BWGRRPT,12) S BWGRTCW=0 D COUNT I $D(BWGRQUIT) K BWGRQUIT G D11
  1. D13 D TITLE I $D(BWGRQUIT) K BWGRQUIT G D12
  1.  D SAVE,ZIS
  1.  Q
  1. SCREEN ;
  1.  S BWGRCNTL="S"
  1.  D ^BWGRVL4
  1.  Q
  1. COUNT ;count only or detailed report
  1.  D COUNT^BWGRVL3
  1.  Q
  1. TITLE ;
  1.  D TITLE^BWGRVL3
  1.  Q
  1. SAVE ;
  1.  D SAVE^BWGRVL3
  1.  Q
  1. ZIS ;call to XBDBQUE
  1.  K BWGROPT
  1.  I 'BWGRTCW S BWGRTCW=IOM
  1.  S BWGRDONE=""
  1.  D SHOW^BWGRVLS,SHOWP^BWGRVLS,SHOWR^BWGRVLS
  1.  D XIT1
  1.  I BWGRCTYP="D"!(BWGRCTYP="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 BWGRQUIT="" Q
  1.  .S BWGROPT=Y
  1.  G:$G(BWGRQUIT) SAVE
  1.  I $G(BWGROPT)="B" D BROWSE,XIT Q
  1.  S XBRP="^BWGRVLP",XBRC="^BWGRVL1",XBRX="XIT^BWGRVL",XBNS="BWGR"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  Q
  1. DEL ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT
  1.  I $G(BWGRRPT),$D(^BWGRTRPT(BWGRRPT,0)),'$P(^BWGRTRPT(BWGRRPT,0),U,2) S DIK="^BWGRTRPT(",DA=BWGRRPT D ^DIK K DIK,DA,DIC
  1.  Q
  1. BROWSE ;
  1.  S XBRP="VIEWR^XBLM(""^BWGRVLP"")"
  1.  S XBRC="^BWGRVL1",XBRX="XIT^BWGRVL",XBIOP=0 D ^XBDBQUE
  1.  Q
  1. XIT ;
  1.  D XIT^BWGRVL1
  1. XIT1 ;
  1.  D XIT1^BWGRVL1
  1.  Q
  1. ADD ;EP
  1.  K BWGRCAND
  1.  W !!
  1.  I $D(BWGRNCAN) G ADD1
  1.  I $D(BWGRSEAT),'$D(BWGREP1) 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 BWGRQUIT=1 Q
  1.  I 'Y G ADD1
  1.  S DIC="^BWGRTRPT(",DIC("S")="I $P(^(0),U,2)&($P(^(0),U,6)=BWGRPTVS)" S:$D(BWGREP1) DIC("S")=DIC("S")_"&($P(^(0),U,9)=BWGRPACK)" S DIC(0)="AEQ",DIC("A")="REPORT NAME:  ",D="C" D IX^DIC K DIC,DA,DR
  1.  I Y=-1 S BWGRQUIT=1 Q
  1.  S BWGRRPT=+Y,BWGRCAND=1
  1.  ;--- set up sorting and report control variables
  1.  S BWGRSORT=$P(^BWGRTRPT(BWGRRPT,0),U,7),BWGRSORV=$P(^(0),U,8),BWGRSPAG=$P(^(0),U,4),BWGRCTYP=$P(^(0),U,5)
  1.  S X=0 F  S X=$O(^BWGRTRPT(BWGRRPT,12,X)) Q:X'=+X  S BWGRTCW=BWGRTCW+$P(^BWGRTRPT(BWGRRPT,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="^BWGRTRPT(",DLAYGO=9002086.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 BWGRQUIT=1 Q
  1.  S BWGRRPT=+Y
  1.  K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
  1.  ;DELETE ALL 11 MULTIPLE HERE
  1.  K ^BWGRTRPT(BWGRRPT,11)
  1.  Q
  1. INFORM ;EP
  1.  S BWGRTCW=0
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR($$LOC(),80),!
  1.  W $$CTR($$USR(),80)
  1.  W !!,$$CTR("WOMEN'S HEALTH GENERAL RETRIEVAL PROGRAM",80),!
  1.  ;W !,"This report will list or count "_$S(BWGRPTVS="P":"Patients",1:"Procedures")," in the Women's Health Register based"
  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 report will list or count patients or procedures in the Women's Health
  1.  ;;Register based on selection criteria entered by the user.  You will be asked
  1.  ;;in three separate steps to identify your selection criteria, what you want
  1.  ;;displayed for each patient and the sorting order for your list.
  1.  ;;You may save the logic used to produce the report for future use.
  1.  ;;If you design a report that is 80 characters or less in width it can be
  1.  ;;displayed on your screen or printed.  If your report is 81-132 characters
  1.  ;;wide, it must be printed - and only on a printer capable of producing
  1.  ;;132 character lines.
  1.  ;;
  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.  ;