WVSELECT ;HCIOFO/FT,JR IHS/ANMC/MWR - SELECT ENTRIES FROM A WVFILE ;
;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; UTILITY TO PROMPT FOR MULTIPLE SELECTIONS FROM A FILE AND STORE
;; THEM IN A LOCAL ARRAY FOR SOWV BY CALLING PROGRAM.
;
HOSP ;---> EXAMPLE: SELECT HOSPITAL LOCATIONS.
D SETVARS^WVUTL5
;---> 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 "WVARR1" OR IT WILL KILL THE VARIBLE,
;---> WVARR1, THAT STORES THE LOCAL ARRAY NAME!
;---> 4TH PARAMETER=SCREEN USED IN SELECTION LOOKUP.
;---> 5TH PARAMETER=DEFAULT FIRST SELECTION.
;---> 6TH PARAMETER=WVPOP=1 IF QUIT OR ERROR.
;---> SCREEN WOULD BE 4TH PARAMETER.
;S WVSCRN="I $D(^SC(,""ARC"",""S"",Y))"
D SELECT("clinic/ward",44,"WVLOC","","",.WVPOP)
Q
;
SELECT(WVITEM,WVFILE,WVARR1,WVSCRN,WVDFLT,WVPOP) ;EP
N DIC,DIR,WVGBL,WVITEMS,Y
I '$D(WVITEM)!('$G(WVFILE))!('$D(WVARR1)) S WVPOP=1 Q
SELECT1 ;
K @WVARR1
S WVGBL=^DIC(WVFILE,0,"GL")
;---> IF .01 FIELD IS A POINTER, RESET GLOBAL TO GET TEXT FROM
;---> POINTED TO GLOBAL.
I $E($P(^DD(WVFILE,.01,0),U,2),2)="P" S WVGBL="^"_$P(^(0),U,3)
D PLURAL
W ! S DIR("A")=" Include ALL "_WVITEMS_" in this listing"
S DIR(0)="Y",DIR("B")="Y"
S DIR("?",1)=" Answer ""YES"" to include ALL "_WVITEMS_";"
S DIR("?")=" Answer ""NO"" to select one or more "_WVITEMS_"."
D ^DIR K DIR
I $D(DIRUT) S WVPOP=1 Q
;---> IF ALL ARE SELECTED, QUIT HERE.
I Y S @(WVARR1_"(""ALL"")")="",WVPOP=0 W ! Q
;
W !!?3,"Select the "_WVITEM_"(s) you wish to include in this listing."
S DIC(0)="QEMA",DIC=WVFILE
S DIC("A")=" Select "_WVITEM_": "
S:$D(WVDFLT) DIC("B")=WVDFLT
S:$D(WVSCRN) DIC("S")=WVSCRN
F D ^DIC K DIC("B") Q:Y<0 S @(WVARR1_"(+Y)")=""
I '$D(@WVARR1) D S WVPOP=1 Q
.W !?3,"No ",WVITEM," selected.",! D DIRZ^WVUTL3
W !!?3,"The following ",WVITEMS," will be included in this report:"
W !?3,$$REPEAT^XLFSTR("-",48+$L(WVITEM))
;W !?3 F I=1:1:48+$L(WVITEM) W "-"
S N=0 F S N=$O(@(WVARR1_"(N)")) Q:'N D
.W !?5,$P(@(WVGBL_"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(@(WVGBL_"N,0)"),U,2)
W ! S DIR(0)="Y",DIR("A")=" Is this correct",DIR("B")="Y"
D ^DIR I $D(DIRUT) S WVPOP=1 Q
I 'Y K @WVARR1 D G SELECT1
.W " All ",WVITEMS," deleted.",!?26," * Please begin again. *"
S WVPOP=0 W !
Q
;
PLURAL ;EP
;---> CHANGE Y TO I AND AS ES IF NECESSARY.
I "Yy"[$E(WVITEM,$L(WVITEM)) D Q
.S WVITEMS=$E(WVITEM,1,($L(WVITEM)-1))_"ies"
S WVITEMS=WVITEM_"s"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVSELECT 2821 printed Nov 22, 2024@17:57:53 Page 2
WVSELECT ;HCIOFO/FT,JR IHS/ANMC/MWR - SELECT ENTRIES FROM A WVFILE ;
+1 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
+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 SOWV BY CALLING PROGRAM.
+5 ;
HOSP ;---> EXAMPLE: SELECT HOSPITAL LOCATIONS.
+1 DO SETVARS^WVUTL5
+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 "WVARR1" OR IT WILL KILL THE VARIBLE,
+6 ;---> WVARR1, THAT STORES THE LOCAL ARRAY NAME!
+7 ;---> 4TH PARAMETER=SCREEN USED IN SELECTION LOOKUP.
+8 ;---> 5TH PARAMETER=DEFAULT FIRST SELECTION.
+9 ;---> 6TH PARAMETER=WVPOP=1 IF QUIT OR ERROR.
+10 ;---> SCREEN WOULD BE 4TH PARAMETER.
+11 ;S WVSCRN="I $D(^SC(,""ARC"",""S"",Y))"
+12 DO SELECT("clinic/ward",44,"WVLOC","","",.WVPOP)
+13 QUIT
+14 ;
SELECT(WVITEM,WVFILE,WVARR1,WVSCRN,WVDFLT,WVPOP) ;EP
+1 NEW DIC,DIR,WVGBL,WVITEMS,Y
+2 IF '$DATA(WVITEM)!('$GET(WVFILE))!('$DATA(WVARR1))
SET WVPOP=1
QUIT
SELECT1 ;
+1 KILL @WVARR1
+2 SET WVGBL=^DIC(WVFILE,0,"GL")
+3 ;---> IF .01 FIELD IS A POINTER, RESET GLOBAL TO GET TEXT FROM
+4 ;---> POINTED TO GLOBAL.
+5 IF $EXTRACT($PIECE(^DD(WVFILE,.01,0),U,2),2)="P"
SET WVGBL="^"_$PIECE(^(0),U,3)
+6 DO PLURAL
+7 WRITE !
SET DIR("A")=" Include ALL "_WVITEMS_" in this listing"
+8 SET DIR(0)="Y"
SET DIR("B")="Y"
+9 SET DIR("?",1)=" Answer ""YES"" to include ALL "_WVITEMS_";"
+10 SET DIR("?")=" Answer ""NO"" to select one or more "_WVITEMS_"."
+11 DO ^DIR
KILL DIR
+12 IF $DATA(DIRUT)
SET WVPOP=1
QUIT
+13 ;---> IF ALL ARE SELECTED, QUIT HERE.
+14 IF Y
SET @(WVARR1_"(""ALL"")")=""
SET WVPOP=0
WRITE !
QUIT
+15 ;
+16 WRITE !!?3,"Select the "_WVITEM_"(s) you wish to include in this listing."
+17 SET DIC(0)="QEMA"
SET DIC=WVFILE
+18 SET DIC("A")=" Select "_WVITEM_": "
+19 if $DATA(WVDFLT)
SET DIC("B")=WVDFLT
+20 if $DATA(WVSCRN)
SET DIC("S")=WVSCRN
+21 FOR
DO ^DIC
KILL DIC("B")
if Y<0
QUIT
SET @(WVARR1_"(+Y)")=""
+22 IF '$DATA(@WVARR1)
Begin DoDot:1
+23 WRITE !?3,"No ",WVITEM," selected.",!
DO DIRZ^WVUTL3
End DoDot:1
SET WVPOP=1
QUIT
+24 WRITE !!?3,"The following ",WVITEMS," will be included in this report:"
+25 WRITE !?3,$$REPEAT^XLFSTR("-",48+$LENGTH(WVITEM))
+26 ;W !?3 F I=1:1:48+$L(WVITEM) W "-"
+27 SET N=0
FOR
SET N=$ORDER(@(WVARR1_"(N)"))
if 'N
QUIT
Begin DoDot:1
+28 WRITE !?5,$PIECE(@(WVGBL_"N,0)"),U)
+29 ;---> NEXT LINE WOULD BE CODE TO BUILD FOR DISPLAYING AN ADDITIONAL
+30 ;---> PIECE OF THE ZERO NODE OF THE SELECTED ENTRIES (IDENTIFIERS).
+31 ;W " - ",$P(@(WVGBL_"N,0)"),U,2)
End DoDot:1
+32 WRITE !
SET DIR(0)="Y"
SET DIR("A")=" Is this correct"
SET DIR("B")="Y"
+33 DO ^DIR
IF $DATA(DIRUT)
SET WVPOP=1
QUIT
+34 IF 'Y
KILL @WVARR1
Begin DoDot:1
+35 WRITE " All ",WVITEMS," deleted.",!?26," * Please begin again. *"
End DoDot:1
GOTO SELECT1
+36 SET WVPOP=0
WRITE !
+37 QUIT
+38 ;
PLURAL ;EP
+1 ;---> CHANGE Y TO I AND AS ES IF NECESSARY.
+2 IF "Yy"[$EXTRACT(WVITEM,$LENGTH(WVITEM))
Begin DoDot:1
+3 SET WVITEMS=$EXTRACT(WVITEM,1,($LENGTH(WVITEM)-1))_"ies"
End DoDot:1
QUIT
+4 SET WVITEMS=WVITEM_"s"
+5 QUIT
