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
