BLREMERA ; IHS/MSC/MKK - BLR EMERgency Alert parameter edit ; 02-May-2016 15:50 ; MKK
;;5.2;IHS LABORATORY;**1039**;NOV 01, 1997;Build 38
;
EEP ; Ersatz EP
D EEP^BLRGMENU
Q
;
PEP ; EP
D CHANGE("BLR EMERGENCY ALERT")
Q
;
COLDTACC ; EP - Collection Date visit Creation parameter
D CHANGE("BLR COLL DT PCC VISIT CREATION")
Q
;
;
CHANGE(PARAMETER) ; EP
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,PARAMETER,U,XPARSYS,XQXFLG)
;
D SETBLRVS
;
S HEADER(1)="IHS Laboratory"
S HEADER(2)=PARAMETER_" Parameter"
S HEADER(3)=$$CJ^XLFSTR("Modify Value",IOM)
;
S RESULT=$$GET^XPAR("PKG",PARAMETER,1,"Q")
S RESULT=$S(RESULT:"YES",RESULT=0:"NO",1:"")
;
D HEADERDT^BLRGMENU
;
D ^XBFMK
S DIR(0)="YO"
S DIR("A")=PARAMETER_" (YES/NO)"
S:$L(RESULT) DIR("B")=RESULT
D ^DIR
;
I +$G(DIRUT)!($G(Y)="") D Q
. W !!,?4,"Invalid/No Entry/Quit. Routine Ends."
. D PRESSKEY^BLRGMENU(9)
;
S ANSWER=$S($E($$UP^XLFSTR(X))="Y":"YES",1:"NO")
;
D EN^XPAR("PKG",PARAMETER,,ANSWER,.ERRS)
;
I +$G(ERRS)<1 D
. S RESULT=$$GET^XPAR("PKG",PARAMETER,1,"Q")
. W !!,?4,PARAMETER," Parameter is currently ",$S(RESULT:"YES",RESULT=0:"NO",1:"")
. D PRESSKEY^BLRGMENU(9)
;
D:+$G(ERRS)>0 RPTERR(.ERRS,PARAMETER)
;
Q
;
RPTERR(ERROR,PARAMETER) ; EP
NEW ERRDESC,ERRNUM,NOWH
;
S ERRNUM=$P(ERROR,"^")
S ERRDESC=$P(ERROR,"^",2)
;
W !!,"*** ERROR Modifying ",PARAMETER," paramter. ***",!!
W ?4,"Error Number:",ERRNUM,!
D LINEWRAP^BLRGMENU(9,ERRDESC,60)
W !
;
D PRESSKEY^BLRGMENU(9)
;
D STORERRS(ERROR,PARAMETER)
Q
;
STORERRS(ERROR,PARAMETER) ; EP - Store Error(s)
NEW (ERROR,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,PARAMETER,U,XPARSYS,XQXFLG)
;
D SETBLRVS
S:$D(^XTMP(BLRVERN))<1 XTMP(BLRVERN)="^"_$$DT^XLFDT_"^Error(s) Modifying "_PARAMETER_" Parameter"
S $P(^XTMP(BLRVERN),"^")=$$HTFM^XLFDT(+$H+90)
;
S NOWH=$H
S ^XTMP(BLRVERN,NOWH)=$$HTE^XLFDT(NOWH,"5Z")
M ^XTMP(BLRVERN,NOWH,"01","DUZ")=DUZ
S ^XTMP(BLRVERN,NOWH,"02","ERROR")=ERROR
;
Q
;
EDITMGRP ; EP - Edit the LAB HIGH URGENCY NOTIFICATION Mail Group
D MAILGRPE("LAB HIGH URGENCY NOTIFICATION")
Q
;
MAILGRPE(MGROUP) ; EP - Mail Group Edit
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,MGROUP,U,XPARSYS,XQXFLG)
;
D SETBLRVS
;
D ADDTMENU^BLRGMENU("ADDTMGRP^BLREMERA","Add User to Mail Group")
D ADDTMENU^BLRGMENU("DELFMGRP^BLREMERA","Delete User From Mail Group")
D ADDTMENU^BLRGMENU("LISTMGRP^BLREMERA","List Users on Mail Group")
;
D MENUDRVR^BLRGMENU("RPMS Lab",MGROUP,$$CJ^XLFSTR("Mail Group Modifications",IOM))
Q
;
ADDTMGRP ; EP - ADD user(s) To Mail GRouP
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,MGROUP,U,XPARSYS,XQXFLG)
;
D SETBLRVS
;
S HEADER(1)="IHS Laboratory"
S HEADER(2)=MGROUP
S HEADER(3)=$$CJ^XLFSTR("Add User to Mail Group",IOM)
;
S ONGO="YES",(NUMADD,NUMERRS)=0
F Q:ONGO="NO" D
. D HEADERDT^BLRGMENU
. D ^XBFMK
. S DIR(0)="PO^200:EMZ"
. D ^DIR
. I +$G(DIRUT) D PROMPTO^BLRUTIL7("Exit/No Entry.") S ONGO="NO" Q
. ;
. S NEWMEM=+Y,NEWMEMN=$P(Y,U,2)
. ;
. K XMY
. S XMY(+Y)=""
. S SUCCESS=$$MG^XMBGRP(MGROUP,,,,.XMY,,1)
. W !!
. I SUCCESS W ?4,NEWMEMN," added to ",MGROUP S NUMADD=NUMADD+1
. E W ?4,NEWMEMN," *NOT* added to ",MGROUP S NUMERRS=NUMERRS+1
. W !
. D PRESSKEY^BLRGMENU(9)
;
W !!,?4,NUMADD," Users added to ",MGROUP,!
W !,?4,NUMERRS," Errors when trying to add users to ",MGROUP,!
D PRESSKEY^BLRGMENU(9)
Q
;
DELFMGRP ; EP - DELete user(s) From Mail GRouP
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,MGROUP,U,XPARSYS,XQXFLG)
;
D SETBLRVS
;
S HEADER(1)="IHS Laboratory"
S HEADER(2)=MGROUP
S HEADER(3)=$$CJ^XLFSTR("Delete User from Mail Group",IOM)
;
S MGIEN=$$FIND1^DIC(3.8,,,MGROUP)
;
S ONGO="YES",(NUMDEL,NUMERRS)=0
F Q:ONGO="NO" D
. D HEADERDT^BLRGMENU
. D ^XBFMK
. Q:$$GETMEMS()<1
. D ^DIR
. I +$G(DIRUT) D PROMPTO^BLRUTIL7("Exit/No Entry.") S ONGO="NO" Q
. ;
. S DELMEM=+SELECTED(Y),DELMEMN=$P($G(SELECTED(Y)),U,2)
. K XMY
. S XMY(DELMEM)=""
. S SUCCESS=$$DM^XMBGRP(MGROUP,.XMY,1)
. W !!
. I SUCCESS W ?4,DELMEMN," deleted from ",MGROUP," Mail Group" S NUMDEL=NUMDEL+1
. E W ?4,DELMEMN," *NOT* deleted from ",MGROUP," Mail Group" S NUMERRS=NUMERRS+1
. W !
. D PRESSKEY^BLRGMENU(9)
;
W !!,?4,$S(NUMDEL:NUMDEL,1:"No")," User",$S(NUMDEL>1:"s",1:"")," deleted from ",MGROUP,!
W:NUMDEL !,?4,NUMERRS," Errors when trying to delete users from ",MGROUP,!
D PRESSKEY^BLRGMENU(9)
Q
;
GETMEMS() ; EP - GET the MEMberS of the Mail Group and setup DIR array
K MEMBER
S (MEMBER,MGMEMIEN)=0
F S MGMEMIEN=$O(^XMB(3.8,MGIEN,1,"B",MGMEMIEN)) Q:MGMEMIEN<1 D
. S MEMBER($$GET1^DIQ(200,MGMEMIEN,.01))=MGMEMIEN
. S MEMBER=MEMBER+1
;
Q:MEMBER<1 0
;
K DIR,SELECTED
S DIR(0)="SO^",TAB=$J("",5)
S MEMNAME="",MEMCNT=0
F S MEMNAME=$O(MEMBER(MEMNAME)) Q:MEMNAME="" D
. S MEMCNT=MEMCNT+1
. S:MEMCNT=1 DIR(0)=$G(DIR(0))_MEMCNT_":"
. S:MEMCNT>1 DIR(0)=$G(DIR(0))_";"_MEMCNT_":"
. S DIR("L",MEMCNT+3)=TAB_MEMCNT_" "_MEMNAME
. S SELECTED(MEMCNT)=$G(MEMBER(MEMNAME))_U_MEMNAME
S DIR("L")=""
S DIR("L",1)="Select one of the users below to delete:"
S DIR("L",2)=""
S DIR("A")="Enter Number"
Q 1
;
LISTMGRP ; EP - LIST all the users on a Mail GRouP
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,MGROUP,U,XPARSYS,XQXFLG)
;
D SETBLRVS
;
S HEADER(1)="IHS Laboratory"
S HEADER(2)=MGROUP
S HEADER(3)=$$CJ^XLFSTR("Mail Group Members",IOM)
;
D HEADERDT^BLRGMENU
D HEADONE^BLRGMENU(.HDRONE)
;
S HEADER(4)=" "
S $E(HEADER(5),5)="DUZ"
S $E(HEADER(5),15)="Name"
S MAXLINES=IOSL-4,LINES=MAXLINES+10
S PG=0,QFLG="NO"
;
S MGIEN=+$$FIND1^DIC(3.8,,,MGROUP)
S MEMBER=.9999999,CNT=0
F S MEMBER=$O(^XMB(3.8,MGIEN,1,MEMBER)) Q:MEMBER<1!(QFLG="Q") D
. I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HDRONE) Q:QFLG="Q"
. S MEMIEN=MEMBER_","_MGIEN
. W ?4,$$GET1^DIQ(3.81,MEMIEN,.01,"I")
. W ?14,$$GET1^DIQ(3.81,MEMIEN,.01)
. W !
. S LINES=LINES+1
. S CNT=CNT+1
;
W !!,?9,CNT," Members"
D PRESSKEY^BLRGMENU(14)
Q
;
;
SETBLRVS(TWO) ; EP - Set the BLRVERN variable
K BLRVERN
;
S BLRVERN=$P($P($T(+1),";")," ")
Q
BLREMERA ; IHS/MSC/MKK - BLR EMERgency Alert parameter edit ; 02-May-2016 15:50 ; MKK
+1 ;;5.2;IHS LABORATORY;**1039**;NOV 01, 1997;Build 38
+2 ;
EEP ; Ersatz EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
PEP ; EP
+1 DO CHANGE("BLR EMERGENCY ALERT")
+2 QUIT
+3 ;
COLDTACC ; EP - Collection Date visit Creation parameter
+1 DO CHANGE("BLR COLL DT PCC VISIT CREATION")
+2 QUIT
+3 ;
+4 ;
CHANGE(PARAMETER) ; EP
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,PARAMETER,U,XPARSYS,XQXFLG)
+2 ;
+3 DO SETBLRVS
+4 ;
+5 SET HEADER(1)="IHS Laboratory"
+6 SET HEADER(2)=PARAMETER_" Parameter"
+7 SET HEADER(3)=$$CJ^XLFSTR("Modify Value",IOM)
+8 ;
+9 SET RESULT=$$GET^XPAR("PKG",PARAMETER,1,"Q")
+10 SET RESULT=$SELECT(RESULT:"YES",RESULT=0:"NO",1:"")
+11 ;
+12 DO HEADERDT^BLRGMENU
+13 ;
+14 DO ^XBFMK
+15 SET DIR(0)="YO"
+16 SET DIR("A")=PARAMETER_" (YES/NO)"
+17 IF $LENGTH(RESULT)
SET DIR("B")=RESULT
+18 DO ^DIR
+19 ;
+20 IF +$GET(DIRUT)!($GET(Y)="")
Begin DoDot:1
+21 WRITE !!,?4,"Invalid/No Entry/Quit. Routine Ends."
+22 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
QUIT
+23 ;
+24 SET ANSWER=$SELECT($EXTRACT($$UP^XLFSTR(X))="Y":"YES",1:"NO")
+25 ;
+26 DO EN^XPAR("PKG",PARAMETER,,ANSWER,.ERRS)
+27 ;
+28 IF +$GET(ERRS)<1
Begin DoDot:1
+29 SET RESULT=$$GET^XPAR("PKG",PARAMETER,1,"Q")
+30 WRITE !!,?4,PARAMETER," Parameter is currently ",$SELECT(RESULT:"YES",RESULT=0:"NO",1:"")
+31 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
+32 ;
+33 IF +$GET(ERRS)>0
DO RPTERR(.ERRS,PARAMETER)
+34 ;
+35 QUIT
+36 ;
RPTERR(ERROR,PARAMETER) ; EP
+1 NEW ERRDESC,ERRNUM,NOWH
+2 ;
+3 SET ERRNUM=$PIECE(ERROR,"^")
+4 SET ERRDESC=$PIECE(ERROR,"^",2)
+5 ;
+6 WRITE !!,"*** ERROR Modifying ",PARAMETER," paramter. ***",!!
+7 WRITE ?4,"Error Number:",ERRNUM,!
+8 DO LINEWRAP^BLRGMENU(9,ERRDESC,60)
+9 WRITE !
+10 ;
+11 DO PRESSKEY^BLRGMENU(9)
+12 ;
+13 DO STORERRS(ERROR,PARAMETER)
+14 QUIT
+15 ;
STORERRS(ERROR,PARAMETER) ; EP - Store Error(s)
+1 NEW (ERROR,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,PARAMETER,U,XPARSYS,XQXFLG)
+2 ;
+3 DO SETBLRVS
+4 IF $DATA(^XTMP(BLRVERN))<1
SET XTMP(BLRVERN)="^"_$$DT^XLFDT_"^Error(s) Modifying "_PARAMETER_" Parameter"
+5 SET $PIECE(^XTMP(BLRVERN),"^")=$$HTFM^XLFDT(+$HOROLOG+90)
+6 ;
+7 SET NOWH=$HOROLOG
+8 SET ^XTMP(BLRVERN,NOWH)=$$HTE^XLFDT(NOWH,"5Z")
+9 MERGE ^XTMP(BLRVERN,NOWH,"01","DUZ")=DUZ
+10 SET ^XTMP(BLRVERN,NOWH,"02","ERROR")=ERROR
+11 ;
+12 QUIT
+13 ;
EDITMGRP ; EP - Edit the LAB HIGH URGENCY NOTIFICATION Mail Group
+1 DO MAILGRPE("LAB HIGH URGENCY NOTIFICATION")
+2 QUIT
+3 ;
MAILGRPE(MGROUP) ; EP - Mail Group Edit
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,MGROUP,U,XPARSYS,XQXFLG)
+2 ;
+3 DO SETBLRVS
+4 ;
+5 DO ADDTMENU^BLRGMENU("ADDTMGRP^BLREMERA","Add User to Mail Group")
+6 DO ADDTMENU^BLRGMENU("DELFMGRP^BLREMERA","Delete User From Mail Group")
+7 DO ADDTMENU^BLRGMENU("LISTMGRP^BLREMERA","List Users on Mail Group")
+8 ;
+9 DO MENUDRVR^BLRGMENU("RPMS Lab",MGROUP,$$CJ^XLFSTR("Mail Group Modifications",IOM))
+10 QUIT
+11 ;
ADDTMGRP ; EP - ADD user(s) To Mail GRouP
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,MGROUP,U,XPARSYS,XQXFLG)
+2 ;
+3 DO SETBLRVS
+4 ;
+5 SET HEADER(1)="IHS Laboratory"
+6 SET HEADER(2)=MGROUP
+7 SET HEADER(3)=$$CJ^XLFSTR("Add User to Mail Group",IOM)
+8 ;
+9 SET ONGO="YES"
SET (NUMADD,NUMERRS)=0
+10 FOR
IF ONGO="NO"
QUIT
Begin DoDot:1
+11 DO HEADERDT^BLRGMENU
+12 DO ^XBFMK
+13 SET DIR(0)="PO^200:EMZ"
+14 DO ^DIR
+15 IF +$GET(DIRUT)
DO PROMPTO^BLRUTIL7("Exit/No Entry.")
SET ONGO="NO"
QUIT
+16 ;
+17 SET NEWMEM=+Y
SET NEWMEMN=$PIECE(Y,U,2)
+18 ;
+19 KILL XMY
+20 SET XMY(+Y)=""
+21 SET SUCCESS=$$MG^XMBGRP(MGROUP,,,,.XMY,,1)
+22 WRITE !!
+23 IF SUCCESS
WRITE ?4,NEWMEMN," added to ",MGROUP
SET NUMADD=NUMADD+1
+24 IF '$TEST
WRITE ?4,NEWMEMN," *NOT* added to ",MGROUP
SET NUMERRS=NUMERRS+1
+25 WRITE !
+26 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
+27 ;
+28 WRITE !!,?4,NUMADD," Users added to ",MGROUP,!
+29 WRITE !,?4,NUMERRS," Errors when trying to add users to ",MGROUP,!
+30 DO PRESSKEY^BLRGMENU(9)
+31 QUIT
+32 ;
DELFMGRP ; EP - DELete user(s) From Mail GRouP
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,MGROUP,U,XPARSYS,XQXFLG)
+2 ;
+3 DO SETBLRVS
+4 ;
+5 SET HEADER(1)="IHS Laboratory"
+6 SET HEADER(2)=MGROUP
+7 SET HEADER(3)=$$CJ^XLFSTR("Delete User from Mail Group",IOM)
+8 ;
+9 SET MGIEN=$$FIND1^DIC(3.8,,,MGROUP)
+10 ;
+11 SET ONGO="YES"
SET (NUMDEL,NUMERRS)=0
+12 FOR
IF ONGO="NO"
QUIT
Begin DoDot:1
+13 DO HEADERDT^BLRGMENU
+14 DO ^XBFMK
+15 IF $$GETMEMS()<1
QUIT
+16 DO ^DIR
+17 IF +$GET(DIRUT)
DO PROMPTO^BLRUTIL7("Exit/No Entry.")
SET ONGO="NO"
QUIT
+18 ;
+19 SET DELMEM=+SELECTED(Y)
SET DELMEMN=$PIECE($GET(SELECTED(Y)),U,2)
+20 KILL XMY
+21 SET XMY(DELMEM)=""
+22 SET SUCCESS=$$DM^XMBGRP(MGROUP,.XMY,1)
+23 WRITE !!
+24 IF SUCCESS
WRITE ?4,DELMEMN," deleted from ",MGROUP," Mail Group"
SET NUMDEL=NUMDEL+1
+25 IF '$TEST
WRITE ?4,DELMEMN," *NOT* deleted from ",MGROUP," Mail Group"
SET NUMERRS=NUMERRS+1
+26 WRITE !
+27 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
+28 ;
+29 WRITE !!,?4,$SELECT(NUMDEL:NUMDEL,1:"No")," User",$SELECT(NUMDEL>1:"s",1:"")," deleted from ",MGROUP,!
+30 IF NUMDEL
WRITE !,?4,NUMERRS," Errors when trying to delete users from ",MGROUP,!
+31 DO PRESSKEY^BLRGMENU(9)
+32 QUIT
+33 ;
GETMEMS() ; EP - GET the MEMberS of the Mail Group and setup DIR array
+1 KILL MEMBER
+2 SET (MEMBER,MGMEMIEN)=0
+3 FOR
SET MGMEMIEN=$ORDER(^XMB(3.8,MGIEN,1,"B",MGMEMIEN))
IF MGMEMIEN<1
QUIT
Begin DoDot:1
+4 SET MEMBER($$GET1^DIQ(200,MGMEMIEN,.01))=MGMEMIEN
+5 SET MEMBER=MEMBER+1
End DoDot:1
+6 ;
+7 IF MEMBER<1
QUIT 0
+8 ;
+9 KILL DIR,SELECTED
+10 SET DIR(0)="SO^"
SET TAB=$JUSTIFY("",5)
+11 SET MEMNAME=""
SET MEMCNT=0
+12 FOR
SET MEMNAME=$ORDER(MEMBER(MEMNAME))
IF MEMNAME=""
QUIT
Begin DoDot:1
+13 SET MEMCNT=MEMCNT+1
+14 IF MEMCNT=1
SET DIR(0)=$GET(DIR(0))_MEMCNT_":"
+15 IF MEMCNT>1
SET DIR(0)=$GET(DIR(0))_";"_MEMCNT_":"
+16 SET DIR("L",MEMCNT+3)=TAB_MEMCNT_" "_MEMNAME
+17 SET SELECTED(MEMCNT)=$GET(MEMBER(MEMNAME))_U_MEMNAME
End DoDot:1
+18 SET DIR("L")=""
+19 SET DIR("L",1)="Select one of the users below to delete:"
+20 SET DIR("L",2)=""
+21 SET DIR("A")="Enter Number"
+22 QUIT 1
+23 ;
LISTMGRP ; EP - LIST all the users on a Mail GRouP
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,MGROUP,U,XPARSYS,XQXFLG)
+2 ;
+3 DO SETBLRVS
+4 ;
+5 SET HEADER(1)="IHS Laboratory"
+6 SET HEADER(2)=MGROUP
+7 SET HEADER(3)=$$CJ^XLFSTR("Mail Group Members",IOM)
+8 ;
+9 DO HEADERDT^BLRGMENU
+10 DO HEADONE^BLRGMENU(.HDRONE)
+11 ;
+12 SET HEADER(4)=" "
+13 SET $EXTRACT(HEADER(5),5)="DUZ"
+14 SET $EXTRACT(HEADER(5),15)="Name"
+15 SET MAXLINES=IOSL-4
SET LINES=MAXLINES+10
+16 SET PG=0
SET QFLG="NO"
+17 ;
+18 SET MGIEN=+$$FIND1^DIC(3.8,,,MGROUP)
+19 SET MEMBER=.9999999
SET CNT=0
+20 FOR
SET MEMBER=$ORDER(^XMB(3.8,MGIEN,1,MEMBER))
IF MEMBER<1!(QFLG="Q")
QUIT
Begin DoDot:1
+21 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,HDRONE)
IF QFLG="Q"
QUIT
+22 SET MEMIEN=MEMBER_","_MGIEN
+23 WRITE ?4,$$GET1^DIQ(3.81,MEMIEN,.01,"I")
+24 WRITE ?14,$$GET1^DIQ(3.81,MEMIEN,.01)
+25 WRITE !
+26 SET LINES=LINES+1
+27 SET CNT=CNT+1
End DoDot:1
+28 ;
+29 WRITE !!,?9,CNT," Members"
+30 DO PRESSKEY^BLRGMENU(14)
+31 QUIT
+32 ;
+33 ;
SETBLRVS(TWO) ; EP - Set the BLRVERN variable
+1 KILL BLRVERN
+2 ;
+3 SET BLRVERN=$PIECE($PIECE($TEXT(+1),";")," ")
+4 QUIT
