BWUTLP ;IHS/CIA/DKM - User prompt APIs;21-Oct-2003 10:04;PLS
;;2.0;WOMEN'S HEALTH;**3,5,7,8,9**;MAY 16, 1996
;
; Prompt for a date range.
; .BWB Start date in FM format (returned)
; .BWE End date in FM format (returned)
; .BWPOP Abort flag (returned)
; BWBDF Default begin date (optional)
; BWEDF Default end date (optional)
; BWSAME If nonzero, default end date is begin date (optional)
; BWTIME If nonzero, ask for time (optional)
;
ASKDATES(BWB,BWE,BWPOP,BWBDF,BWEDF,BWSAME,BWTIME) ; EP
N BWOPT
W !!," *** Date Range Selection ***"
S BWPOP=0,BWOPT=$S($G(BWTIME):"T",1:"")
S BWB=$$ASKDATE(" Begin with DATE: ",.BWBDF,,BWOPT)
S:'BWPOP BWE=$$ASKDATE(" End with DATE: ",$S($G(BWSAME):BWB,$G(BWEDF):BWEDF,1:""),BWB,BWOPT)
Q
; Prompt for single date date
; BWPMT = Prompt
; BWDFL = Default value (optional)
; BWMIN = Minimum value (optional)
; BWOPT = Additional options (optional)
ASKDATE(BWPMT,BWDFL,BWMIN,BWOPT) ;
N %DT,Y
S %DT="APEX"_$G(BWOPT)
S %DT("A")=BWPMT
S:$G(BWMIN) %DT(0)=BWMIN
I $G(BWDFL) D
.S Y=BWDFL
.D DD^%DT
.S %DT("B")=Y
D ^%DT
S:Y<0 BWPOP=1
Q Y
; Record locked
LOCKED D SHOWDLG(-4)
Q
; Locked pregnancy log entry
LOCKEDE D SHOWDLG(-3)
Q
; Locked pap log entry
LOCKEDP D SHOWDLG(-2)
Q
;
; DIR call for Y/N response
DIRYN(BWPMT,BWDFL,BWHLP,BWPOP) ; EP
N Y
S Y=$$DIR("YO",.BWPMT,.BWDFL,.BWHLP,.BWPOP)
;IHS exemption approved on 10/20/2003
Q:$Q Y
Q
;
; Paramerized DIR call
DIR(BWDTP,BWPMT,BWDFL,BWHLP,BWPOP,BWSCN) ; EP
N DIR,DTOUT,DUOUT,Y
S DIR(0)=BWDTP,DIR("B")=$G(BWDFL)
I '$G(BWPMT) M DIR("A")=BWPMT
E D GETTEXT(BWPMT,$NA(DIR("A")))
I '$G(BWHLP) M DIR("?")=BWHLP
E D GETTEXT(BWHLP,$NA(DIR("?")))
S:$L($G(BWSCN)) DIR("S")=BWSCN
D ^DIR
S:$D(DUOUT)!$D(DTOUT) BWPOP=1
;IHS exemption approved on 10/20/2003
Q:$Q Y
Q
; Pause for user input
DIRZ ; EP
D DIR("E",,,,.BWPOP)
Q
; Display dialog text
; BWDG = Dialog index (negative value causes pause)
SHOWDLG(BWDG) ; EP
Q:$D(BWSILENT)!$D(ZTQUEUED)
N BWX
D GETTEXT(BWDG,"BWX")
S BWX=0
W:$X !
F S BWX=$O(BWX(BWX)) Q:'BWX W BWX(BWX),!
D:BWDG<0 DIRZ
Q
; Load dialog text into array
; BWDG = Dialog index^optional parameters
; BWAR = Array to receive text
GETTEXT(BWDG,BWAR) ;
N BWPM
K @BWAR
F X=2:1:$L(BWDG,U) S BWPM(X-1)=$P(BWDG,U,X)
S BWDG=$S(BWDG<0:-BWDG,1:+BWDG)
D BLD^DIALOG(BWDG/1000+9002086,.BWPM,,BWAR)
Q
;
; Prompt for entry from file
; BWFILE = File #
; BWPMPT = Prompt
GETIEN(BWFILE,BWPMPT) ; EP
N DIC,BWD,Y
S BWD=$$GET1^DIQ(BWFILE,$$FIND1^DIC(BWFILE,,," "),.01)
S DIC=BWFILE,DIC(0)="AE",DIC("A")=$G(BWPMPT),DIC("B")=BWD
D ^DIC
S:Y'>0 BWPOP=1
Q +Y
; Select one or more items from a file or set of codes
; BWITEM = Item descriptor (start with "-" if exclusion)
; BWFILE = File #
; BWARRY = Array name to receive selections
; BWSCRN = Optional screen
; BWDFLT = Optional default value
; BWFLD = If target lookup is a set, pass the field # for the set
; BWASK = Optional flag to issue Y/N prompt (default = 1)
SELECT(BWITEM,BWFILE,BWARRY,BWSCRN,BWDFLT,BWPOP,BWFLD,BWASK) ; EP
N BWITEMS,BWDONE,BWIE
I '$D(BWITEM)!'$G(BWFILE)!'$D(BWARRY) S BWPOP=1 Q
I $E(BWITEM)="-" S $E(BWITEM)="",BWIE="excluded from"
E S BWIE="included in"
S BWITEMS=$S("Yy"[$E(BWITEM,$L(BWITEM)):$E(BWITEM,1,$L(BWITEM)-1)_"ies",1:BWITEM_"s"),BWDONE=0,BWASK=$G(BWASK,1)
K @BWARRY
F D Q:BWPOP!BWDONE
.N DIC,Y,BWX
.S:BWASK BWDONE=$$DIRYN(14_U_BWITEMS,"YES",13_U_BWITEMS,.BWPOP)
.Q:BWPOP!BWDONE
.D SHOWDLG(15_U_BWITEM_U_BWIE)
.I $G(BWFLD) D
..F D Q:Y<1
...S Y=+$$DIR(BWFILE_","_BWFLD_"O","Select "_BWITEM,.BWDFLT,,.BWPOP,.BWSCRN)
...S:Y>0 @BWARRY@(Y)=""
.E D
..S DIC(0)="QEMA",DIC=BWFILE,DIC("A")="Select "_BWITEM_": "
..S:$D(BWDFLT) DIC("B")=BWDFLT
..S:$D(BWSCRN) DIC("S")=BWSCRN
..F D ^DIC K DIC("B") Q:Y<0 S @BWARRY@(+Y)=""
.D SHOWDLG($S($D(@BWARRY):17,1:16)_U_BWITEMS_U_BWIE)
.S BWX=""
.F S BWX=$O(@BWARRY@(BWX)) Q:'$L(BWX) D
..I $G(BWFLD) W ?5,$$EXTERNAL^DILFD(BWFILE,BWFLD,,BWX),!
..E W ?5,$$GET1^DIQ(BWFILE,BWX,.01),!
.W !
.S BWDONE=$$DIRYN("Is this correct","YES",,.BWPOP)
.I 'BWDONE D
..K @BWARRY
..D:'BWPOP SHOWDLG(18_U_BWITEMS)
Q
BWUTLP ;IHS/CIA/DKM - User prompt APIs;21-Oct-2003 10:04;PLS
+1 ;;2.0;WOMEN'S HEALTH;**3,5,7,8,9**;MAY 16, 1996
+2 ;
+3 ; Prompt for a date range.
+4 ; .BWB Start date in FM format (returned)
+5 ; .BWE End date in FM format (returned)
+6 ; .BWPOP Abort flag (returned)
+7 ; BWBDF Default begin date (optional)
+8 ; BWEDF Default end date (optional)
+9 ; BWSAME If nonzero, default end date is begin date (optional)
+10 ; BWTIME If nonzero, ask for time (optional)
+11 ;
ASKDATES(BWB,BWE,BWPOP,BWBDF,BWEDF,BWSAME,BWTIME) ; EP
+1 NEW BWOPT
+2 WRITE !!," *** Date Range Selection ***"
+3 SET BWPOP=0
SET BWOPT=$SELECT($GET(BWTIME):"T",1:"")
+4 SET BWB=$$ASKDATE(" Begin with DATE: ",.BWBDF,,BWOPT)
+5 IF 'BWPOP
SET BWE=$$ASKDATE(" End with DATE: ",$SELECT($GET(BWSAME):BWB,$GET(BWEDF):BWEDF,1:""),BWB,BWOPT)
+6 QUIT
+7 ; Prompt for single date date
+8 ; BWPMT = Prompt
+9 ; BWDFL = Default value (optional)
+10 ; BWMIN = Minimum value (optional)
+11 ; BWOPT = Additional options (optional)
ASKDATE(BWPMT,BWDFL,BWMIN,BWOPT) ;
+1 NEW %DT,Y
+2 SET %DT="APEX"_$GET(BWOPT)
+3 SET %DT("A")=BWPMT
+4 IF $GET(BWMIN)
SET %DT(0)=BWMIN
+5 IF $GET(BWDFL)
Begin DoDot:1
+6 SET Y=BWDFL
+7 DO DD^%DT
+8 SET %DT("B")=Y
End DoDot:1
+9 DO ^%DT
+10 IF Y<0
SET BWPOP=1
+11 QUIT Y
+12 ; Record locked
LOCKED DO SHOWDLG(-4)
+1 QUIT
+2 ; Locked pregnancy log entry
LOCKEDE DO SHOWDLG(-3)
+1 QUIT
+2 ; Locked pap log entry
LOCKEDP DO SHOWDLG(-2)
+1 QUIT
+2 ;
+3 ; DIR call for Y/N response
DIRYN(BWPMT,BWDFL,BWHLP,BWPOP) ; EP
+1 NEW Y
+2 SET Y=$$DIR("YO",.BWPMT,.BWDFL,.BWHLP,.BWPOP)
+3 ;IHS exemption approved on 10/20/2003
+4 IF $QUIT
QUIT Y
+5 QUIT
+6 ;
+7 ; Paramerized DIR call
DIR(BWDTP,BWPMT,BWDFL,BWHLP,BWPOP,BWSCN) ; EP
+1 NEW DIR,DTOUT,DUOUT,Y
+2 SET DIR(0)=BWDTP
SET DIR("B")=$GET(BWDFL)
+3 IF '$GET(BWPMT)
MERGE DIR("A")=BWPMT
+4 IF '$TEST
DO GETTEXT(BWPMT,$NAME(DIR("A")))
+5 IF '$GET(BWHLP)
MERGE DIR("?")=BWHLP
+6 IF '$TEST
DO GETTEXT(BWHLP,$NAME(DIR("?")))
+7 IF $LENGTH($GET(BWSCN))
SET DIR("S")=BWSCN
+8 DO ^DIR
+9 IF $DATA(DUOUT)!$DATA(DTOUT)
SET BWPOP=1
+10 ;IHS exemption approved on 10/20/2003
+11 IF $QUIT
QUIT Y
+12 QUIT
+13 ; Pause for user input
DIRZ ; EP
+1 DO DIR("E",,,,.BWPOP)
+2 QUIT
+3 ; Display dialog text
+4 ; BWDG = Dialog index (negative value causes pause)
SHOWDLG(BWDG) ; EP
+1 IF $DATA(BWSILENT)!$DATA(ZTQUEUED)
QUIT
+2 NEW BWX
+3 DO GETTEXT(BWDG,"BWX")
+4 SET BWX=0
+5 IF $X
WRITE !
+6 FOR
SET BWX=$ORDER(BWX(BWX))
IF 'BWX
QUIT
WRITE BWX(BWX),!
+7 IF BWDG<0
DO DIRZ
+8 QUIT
+9 ; Load dialog text into array
+10 ; BWDG = Dialog index^optional parameters
+11 ; BWAR = Array to receive text
GETTEXT(BWDG,BWAR) ;
+1 NEW BWPM
+2 KILL @BWAR
+3 FOR X=2:1:$LENGTH(BWDG,U)
SET BWPM(X-1)=$PIECE(BWDG,U,X)
+4 SET BWDG=$SELECT(BWDG<0:-BWDG,1:+BWDG)
+5 DO BLD^DIALOG(BWDG/1000+9002086,.BWPM,,BWAR)
+6 QUIT
+7 ;
+8 ; Prompt for entry from file
+9 ; BWFILE = File #
+10 ; BWPMPT = Prompt
GETIEN(BWFILE,BWPMPT) ; EP
+1 NEW DIC,BWD,Y
+2 SET BWD=$$GET1^DIQ(BWFILE,$$FIND1^DIC(BWFILE,,," "),.01)
+3 SET DIC=BWFILE
SET DIC(0)="AE"
SET DIC("A")=$GET(BWPMPT)
SET DIC("B")=BWD
+4 DO ^DIC
+5 IF Y'>0
SET BWPOP=1
+6 QUIT +Y
+7 ; Select one or more items from a file or set of codes
+8 ; BWITEM = Item descriptor (start with "-" if exclusion)
+9 ; BWFILE = File #
+10 ; BWARRY = Array name to receive selections
+11 ; BWSCRN = Optional screen
+12 ; BWDFLT = Optional default value
+13 ; BWFLD = If target lookup is a set, pass the field # for the set
+14 ; BWASK = Optional flag to issue Y/N prompt (default = 1)
SELECT(BWITEM,BWFILE,BWARRY,BWSCRN,BWDFLT,BWPOP,BWFLD,BWASK) ; EP
+1 NEW BWITEMS,BWDONE,BWIE
+2 IF '$DATA(BWITEM)!'$GET(BWFILE)!'$DATA(BWARRY)
SET BWPOP=1
QUIT
+3 IF $EXTRACT(BWITEM)="-"
SET $EXTRACT(BWITEM)=""
SET BWIE="excluded from"
+4 IF '$TEST
SET BWIE="included in"
+5 SET BWITEMS=$SELECT("Yy"[$EXTRACT(BWITEM,$LENGTH(BWITEM)):$EXTRACT(BWITEM,1,$LENGTH(BWITEM)-1)_"ies",1:BWITEM_"s")
SET BWDONE=0
SET BWASK=$GET(BWASK,1)
+6 KILL @BWARRY
+7 FOR
Begin DoDot:1
+8 NEW DIC,Y,BWX
+9 IF BWASK
SET BWDONE=$$DIRYN(14_U_BWITEMS,"YES",13_U_BWITEMS,.BWPOP)
+10 IF BWPOP!BWDONE
QUIT
+11 DO SHOWDLG(15_U_BWITEM_U_BWIE)
+12 IF $GET(BWFLD)
Begin DoDot:2
+13 FOR
Begin DoDot:3
+14 SET Y=+$$DIR(BWFILE_","_BWFLD_"O","Select "_BWITEM,.BWDFLT,,.BWPOP,.BWSCRN)
+15 IF Y>0
SET @BWARRY@(Y)=""
End DoDot:3
IF Y<1
QUIT
End DoDot:2
+16 IF '$TEST
Begin DoDot:2
+17 SET DIC(0)="QEMA"
SET DIC=BWFILE
SET DIC("A")="Select "_BWITEM_": "
+18 IF $DATA(BWDFLT)
SET DIC("B")=BWDFLT
+19 IF $DATA(BWSCRN)
SET DIC("S")=BWSCRN
+20 FOR
DO ^DIC
KILL DIC("B")
IF Y<0
QUIT
SET @BWARRY@(+Y)=""
End DoDot:2
+21 DO SHOWDLG($SELECT($DATA(@BWARRY):17,1:16)_U_BWITEMS_U_BWIE)
+22 SET BWX=""
+23 FOR
SET BWX=$ORDER(@BWARRY@(BWX))
IF '$LENGTH(BWX)
QUIT
Begin DoDot:2
+24 IF $GET(BWFLD)
WRITE ?5,$$EXTERNAL^DILFD(BWFILE,BWFLD,,BWX),!
+25 IF '$TEST
WRITE ?5,$$GET1^DIQ(BWFILE,BWX,.01),!
End DoDot:2
+26 WRITE !
+27 SET BWDONE=$$DIRYN("Is this correct","YES",,.BWPOP)
+28 IF 'BWDONE
Begin DoDot:2
+29 KILL @BWARRY
+30 IF 'BWPOP
DO SHOWDLG(18_U_BWITEMS)
End DoDot:2
End DoDot:1
IF BWPOP!BWDONE
QUIT
+31 QUIT
