BWSELECT.m

BWSELECT ;IHS/ANMC/MWR - SELECT ENTRIES FROM A BWFILE ;15-Feb-2003 22:11;PLS

 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 ;;  UTILITY TO PROMPT FOR MULTIPLE SELECTIONS FROM A FILE AND STORE

 ;;  THEM IN A LOCAL ARRAY FOR SOBW BY CALLING PROGRAM.

 ;

HOSP ;---> EXAMPLE: SELECT HOSPITAL LOCATIONS.

 D SETVARS^BWUTL5

 ;---> 1ST PARAMETER=CATAGORIC NAME OF ITEMS BEING SELECTED.

 ;---> 2ND PARAMETER=FILE NUMBER FROM WHICH SELECTION IS MADE.

 ;---> 3RD PARAMETER=LOCAL ARRAY IN WHICH SELECTIONS WILL BE STORED.

 ;--->     NOTE: THIS CANNOT BE "BWARR1" OR IT WILL KILL THE VARIBLE,

 ;--->           BWARR1, THAT STORES THE LOCAL ARRAY NAME!

 ;---> 4TH PARAMETER=SCREEN USED IN SELECTION LOOKUP.

 ;---> 5TH PARAMETER=DEFAULT FIRST SELECTION.

 ;---> 6TH PARAMETER=BWPOP=1 IF QUIT OR ERROR.

 ;---> SCREEN WOULD BE 4TH PARAMETER.

 ;S BWSCRN="I $D(^SC(,""ARC"",""S"",Y))"

 D SELECT("clinic/ward",44,"BWLOC","","",.BWPOP)

 Q

 ;

SELECT(BWITEM,BWFILE,BWARR1,BWSCRN,BWDFLT,BWPOP) ;EP

 N DIC,DIR,BWGBL,BWITEMS,Y

 I '$D(BWITEM)!('$G(BWFILE))!('$D(BWARR1)) S BWPOP=1 Q

SELECT1 ;

 K @BWARR1

 S BWGBL=^DIC(BWFILE,0,"GL")

 ;---> IF .01 FIELD IS A POINTER, RESET GLOBAL TO GET TEXT FROM

 ;---> POINTED TO GLOBAL.

 I $E($P(^DD(BWFILE,.01,0),U,2),2)="P" S BWGBL="^"_$P(^(0),U,3)

 D PLURAL

 W ! S DIR("A")="   Include ALL "_BWITEMS_" in this listing"

 S DIR(0)="Y",DIR("B")="Y"

 S DIR("?",1)="     Answer ""YES"" to include ALL "_BWITEMS_";"

 S DIR("?")="     Answer ""NO"" to select one or more "_BWITEMS_"."

 D ^DIR K DIR

 I $D(DIRUT) S BWPOP=1 Q

 ;---> IF ALL ARE SELECTED, QUIT HERE.

 I Y S @(BWARR1_"(""ALL"")")="",BWPOP=0 W ! Q

 ;

 W !!?3,"Select the "_BWITEM_"(s) you wish to include in this listing."

 S DIC(0)="QEMA",DIC=BWFILE

 S 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 @(BWARR1_"(+Y)")=""

 I '$D(@BWARR1) D  S BWPOP=1 Q

 .W !?3,"No ",BWITEM," selected.",! D DIRZ^BWUTL3

 W !!?3,"The following ",BWITEMS," will be included in this report:"

 W !?3 F I=1:1:48+$L(BWITEM) W "-"

 S N=0 F  S N=$O(@(BWARR1_"(N)")) Q:'N  D

 .W !?5,$P(@(BWGBL_"N,0)"),U)

 .;---> NEXT LINE WOULD BE CODE TO BUILD FOR DISPLAYING AN ADDITIONAL

 .;---> PIECE OF THE ZERO NODE OF THE SELECTED ENTRIES (IDENTIFIERS).

 .;W " - ",$P(@(BWGBL_"N,0)"),U,2)

 W ! S DIR(0)="Y",DIR("A")="   Is this correct",DIR("B")="Y"

 D ^DIR I $D(DIRUT) S BWPOP=1 Q

 I 'Y K @BWARR1 D  G SELECT1

 .W "   All ",BWITEMS," deleted.",!?26," * Please begin again. *"

 S BWPOP=0 W !

 Q

 ;

PLURAL ;EP

 ;---> CHANGE Y TO I AND AS ES IF NECESSARY.

 I "Yy"[$E(BWITEM,$L(BWITEM)) D  Q

 .S BWITEMS=$E(BWITEM,1,($L(BWITEM)-1))_"ies"

 S BWITEMS=BWITEM_"s"

 Q

BWSELECT  ;IHS/ANMC/MWR - SELECT ENTRIES FROM A BWFILE ;15-Feb-2003 22:11;PLS

 +1       ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

 +2       ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 +3       ;;  UTILITY TO PROMPT FOR MULTIPLE SELECTIONS FROM A FILE AND STORE

 +4       ;;  THEM IN A LOCAL ARRAY FOR SOBW BY CALLING PROGRAM.

 +5       ;

HOSP      ;---> EXAMPLE: SELECT HOSPITAL LOCATIONS.

 +1        DO SETVARS^BWUTL5

 +2       ;---> 1ST PARAMETER=CATAGORIC NAME OF ITEMS BEING SELECTED.

 +3       ;---> 2ND PARAMETER=FILE NUMBER FROM WHICH SELECTION IS MADE.

 +4       ;---> 3RD PARAMETER=LOCAL ARRAY IN WHICH SELECTIONS WILL BE STORED.

 +5       ;--->     NOTE: THIS CANNOT BE "BWARR1" OR IT WILL KILL THE VARIBLE,

 +6       ;--->           BWARR1, THAT STORES THE LOCAL ARRAY NAME!

 +7       ;---> 4TH PARAMETER=SCREEN USED IN SELECTION LOOKUP.

 +8       ;---> 5TH PARAMETER=DEFAULT FIRST SELECTION.

 +9       ;---> 6TH PARAMETER=BWPOP=1 IF QUIT OR ERROR.

 +10      ;---> SCREEN WOULD BE 4TH PARAMETER.

 +11      ;S BWSCRN="I $D(^SC(,""ARC"",""S"",Y))"

 +12       DO SELECT("clinic/ward",44,"BWLOC","","",.BWPOP)

 +13       QUIT 

 +14      ;

SELECT(BWITEM,BWFILE,BWARR1,BWSCRN,BWDFLT,BWPOP) ;EP

 +1        NEW DIC,DIR,BWGBL,BWITEMS,Y

 +2        IF '$DATA(BWITEM)!('$GET(BWFILE))!('$DATA(BWARR1))

               SET BWPOP=1

               QUIT 

SELECT1   ;

 +1        KILL @BWARR1

 +2        SET BWGBL=^DIC(BWFILE,0,"GL")

 +3       ;---> IF .01 FIELD IS A POINTER, RESET GLOBAL TO GET TEXT FROM

 +4       ;---> POINTED TO GLOBAL.

 +5        IF $EXTRACT($PIECE(^DD(BWFILE,.01,0),U,2),2)="P"

               SET BWGBL="^"_$PIECE(^(0),U,3)

 +6        DO PLURAL

 +7        WRITE !

           SET DIR("A")="   Include ALL "_BWITEMS_" in this listing"

 +8        SET DIR(0)="Y"

           SET DIR("B")="Y"

 +9        SET DIR("?",1)="     Answer ""YES"" to include ALL "_BWITEMS_";"

 +10       SET DIR("?")="     Answer ""NO"" to select one or more "_BWITEMS_"."

 +11       DO ^DIR

           KILL DIR

 +12       IF $DATA(DIRUT)

               SET BWPOP=1

               QUIT 

 +13      ;---> IF ALL ARE SELECTED, QUIT HERE.

 +14       IF Y

               SET @(BWARR1_"(""ALL"")")=""

               SET BWPOP=0

               WRITE !

               QUIT 

 +15      ;

 +16       WRITE !!?3,"Select the "_BWITEM_"(s) you wish to include in this listing."

 +17       SET DIC(0)="QEMA"

           SET DIC=BWFILE

 +18       SET DIC("A")="   Select "_BWITEM_": "

 +19       IF $DATA(BWDFLT)

               SET DIC("B")=BWDFLT

 +20       IF $DATA(BWSCRN)

               SET DIC("S")=BWSCRN

 +21       FOR 

               DO ^DIC

               KILL DIC("B")

               IF Y<0

                   QUIT 

               SET @(BWARR1_"(+Y)")=""

 +22       IF '$DATA(@BWARR1)

               Begin DoDot:1

 +23               WRITE !?3,"No ",BWITEM," selected.",!

                   DO DIRZ^BWUTL3

               End DoDot:1

               SET BWPOP=1

               QUIT 

 +24       WRITE !!?3,"The following ",BWITEMS," will be included in this report:"

 +25       WRITE !?3

           FOR I=1:1:48+$LENGTH(BWITEM)

               WRITE "-"

 +26       SET N=0

           FOR 

               SET N=$ORDER(@(BWARR1_"(N)"))

               IF 'N

                   QUIT 

               Begin DoDot:1

 +27               WRITE !?5,$PIECE(@(BWGBL_"N,0)"),U)

 +28      ;---> NEXT LINE WOULD BE CODE TO BUILD FOR DISPLAYING AN ADDITIONAL

 +29      ;---> PIECE OF THE ZERO NODE OF THE SELECTED ENTRIES (IDENTIFIERS).

 +30      ;W " - ",$P(@(BWGBL_"N,0)"),U,2)

               End DoDot:1

 +31       WRITE !

           SET DIR(0)="Y"

           SET DIR("A")="   Is this correct"

           SET DIR("B")="Y"

 +32       DO ^DIR

           IF $DATA(DIRUT)

               SET BWPOP=1

               QUIT 

 +33       IF 'Y

               KILL @BWARR1

               Begin DoDot:1

 +34               WRITE "   All ",BWITEMS," deleted.",!?26," * Please begin again. *"

               End DoDot:1

               GOTO SELECT1

 +35       SET BWPOP=0

           WRITE !

 +36       QUIT 

 +37      ;

PLURAL    ;EP

 +1       ;---> CHANGE Y TO I AND AS ES IF NECESSARY.

 +2        IF "Yy"[$EXTRACT(BWITEM,$LENGTH(BWITEM))

               Begin DoDot:1

 +3                SET BWITEMS=$EXTRACT(BWITEM,1,($LENGTH(BWITEM)-1))_"ies"

               End DoDot:1

               QUIT 

 +4        SET BWITEMS=BWITEM_"s"

 +5        QUIT