BWUTLP.m

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