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