EDPBKS ;SLC/MKB -- EDPF BIGBOARD KIOSKS list template ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
EN ; -- main entry point
S EDPSITE=$$DIV Q:EDPSITE<1
D EN^VALM("EDPF BIGBOARD KIOSKS")
Q
;
HDR ; -- header code
N X S X=$$NS^XUAF4(EDPSITE)
S VALMHDR(1)="Division: "_$P(X,U)_" ("_$P(X,U,2)_")"
Q
;
INIT ; -- init variables and list array EDPB
N EDPX,I,X K EDPB
D GETLST^XPAR(.EDPX,"DIV.`"_EDPSITE,"EDPF BIGBOARD KIOSKS")
S VALMCNT=EDPX I EDPX F I=1:1:EDPX D
. S X=EDPX(I),EDPB("IDX",I)=X
. N X1,X2 S X1=$P(X,U),X2=$P(X,U,2)
. S:$L(X1)>37 X1=$E(X1,1,37)_"..." S:$L(X2)>27 X2=$E(X2,1,27)_"..."
. S EDPB(I,0)=$$LJ^XLFSTR(I,4)_$$LJ^XLFSTR(X1,40)_X2
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K EDPSITE
Q
;
DIV() ; -- select division
N X,Y,DIC
S DIC=4,DIC(0)="AEQM"
; DIC("S")= only local divisions ??
D ^DIC S Y=$S(Y<1:"",1:+Y)
Q Y
;
ENTER(NAME,DEFAULT) ; -- prompt for NAME
N X,Y,DIR,DTOUT,DUOUT
S DIR(0)="FAO",DIR("A")=NAME_": " S:$L($G(DEFAULT)) DIR("B")=DEFAULT
I $E(NAME)="C" S DIR("?")="Enter a fully specified computer name; this will be saved in lowercase."
E S DIR("?")="Enter the name of the board to be displayed on this computer; this value is case-sensitive."
D ^DIR I $G(DTOUT)!$G(DUOUT) S Y=""
Q Y
;
SELECT() ; -- select item from list by number
N X,Y,DIR,DTOUT,DUOUT
S DIR(0)="NAO^1:"_VALMCNT,DIR("A")="Select computer/board: "
D ^DIR
Q Y
;
SURE(NAME) ; -- are you sure?
N X,Y,DIR,DTOUT,DUOUT W !
S DIR("A",1)="Deletions are done immediately!"
S DIR(0)="YA",DIR("A")="Are you sure"_$S($L($G(NAME)):" you want to remove "_NAME,1:"")_"? "
D ^DIR
Q Y
;
; -- EDPF BIGBOARD MENU actions --
;
NEWDIV ; -- select new division
N X D FULL^VALM1 S VALMBCK="R"
S X=$$DIV I X,X'=EDPSITE D
. W !,"Rebuilding list ..." H 1
. S EDPSITE=X D INIT
. K VALMHDR
Q
;
ADD ; -- add a computer/board
N INST,VAL,DONE,EDPERR,MORE
D FULL^VALM1 S VALMBCK="R" W !
S (DONE,MORE)=0 F D Q:DONE
. S INST=$$ENTER("Computer Name") I '$L(INST) S DONE=1 Q
. S INST=$$LOW^XLFSTR(INST) ;enforce lowercase
. S VAL=$$ENTER("Display Board") I '$L(VAL) S DONE=1 Q
. D ADD^XPAR("DIV.`"_EDPSITE,"EDPF BIGBOARD KIOSKS",INST,VAL,.EDPERR)
. I EDPERR W !,$P(EDPERR,U,2),! H 2 Q
. S MORE=1 W !
D:MORE INIT
Q
;
REM ; -- remove a computer/board
N NUM,INST,EDPERR S VALMBCK=""
S NUM=$$SELECT Q:NUM<1
S INST=$P($G(EDPB("IDX",NUM)),U)
I '$L(INST) W !,"Invalid selection" H 1 Q
Q:'$$SURE(INST)
D DEL^XPAR("DIV.`"_EDPSITE,"EDPF BIGBOARD KIOSKS",INST,.EDPERR)
I EDPERR W !,$P(EDPERR,U,2) H 2 Q
W !,"Board removed." H 1
D INIT S VALMBCK="R"
Q
;
CHG ; -- change a computer or board name
N NUM,OLD,INST,VAL,EDPERR S VALMBCK=""
S NUM=$$SELECT Q:NUM<1
S OLD=$G(EDPB("IDX",NUM)),VALMBCK="R"
S INST=$$ENTER("Computer Name",$P(OLD,U)) Q:'$L(INST)
S INST=$$LOW^XLFSTR(INST) ;enforce lowercase
S VAL=$$ENTER("Display Board",$P(OLD,U,2)) Q:'$L(VAL)
I OLD=(INST_U_VAL) Q ;no change
I INST'=$P(OLD,U) D Q:EDPERR
. D REP^XPAR("DIV.`"_EDPSITE,"EDPF BIGBOARD KIOSKS",$P(OLD,U),INST,.EDPERR)
. I EDPERR W !,$P(EDPERR,U,2) H 2
I VAL'=$P(OLD,U,2) D
. D CHG^XPAR("DIV.`"_EDPSITE,"EDPF BIGBOARD KIOSKS",INST,VAL,.EDPERR)
. I EDPERR W !,$P(EDPERR,U,2) H 2 Q
D INIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPBKS 3364 printed Dec 13, 2024@01:51:32 Page 2
EDPBKS ;SLC/MKB -- EDPF BIGBOARD KIOSKS list template ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
EN ; -- main entry point
+1 SET EDPSITE=$$DIV
if EDPSITE<1
QUIT
+2 DO EN^VALM("EDPF BIGBOARD KIOSKS")
+3 QUIT
+4 ;
HDR ; -- header code
+1 NEW X
SET X=$$NS^XUAF4(EDPSITE)
+2 SET VALMHDR(1)="Division: "_$PIECE(X,U)_" ("_$PIECE(X,U,2)_")"
+3 QUIT
+4 ;
INIT ; -- init variables and list array EDPB
+1 NEW EDPX,I,X
KILL EDPB
+2 DO GETLST^XPAR(.EDPX,"DIV.`"_EDPSITE,"EDPF BIGBOARD KIOSKS")
+3 SET VALMCNT=EDPX
IF EDPX
FOR I=1:1:EDPX
Begin DoDot:1
+4 SET X=EDPX(I)
SET EDPB("IDX",I)=X
+5 NEW X1,X2
SET X1=$PIECE(X,U)
SET X2=$PIECE(X,U,2)
+6 if $LENGTH(X1)>37
SET X1=$EXTRACT(X1,1,37)_"..."
if $LENGTH(X2)>27
SET X2=$EXTRACT(X2,1,27)_"..."
+7 SET EDPB(I,0)=$$LJ^XLFSTR(I,4)_$$LJ^XLFSTR(X1,40)_X2
End DoDot:1
+8 QUIT
+9 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL EDPSITE
+2 QUIT
+3 ;
DIV() ; -- select division
+1 NEW X,Y,DIC
+2 SET DIC=4
SET DIC(0)="AEQM"
+3 ; DIC("S")= only local divisions ??
+4 DO ^DIC
SET Y=$SELECT(Y<1:"",1:+Y)
+5 QUIT Y
+6 ;
ENTER(NAME,DEFAULT) ; -- prompt for NAME
+1 NEW X,Y,DIR,DTOUT,DUOUT
+2 SET DIR(0)="FAO"
SET DIR("A")=NAME_": "
if $LENGTH($GET(DEFAULT))
SET DIR("B")=DEFAULT
+3 IF $EXTRACT(NAME)="C"
SET DIR("?")="Enter a fully specified computer name; this will be saved in lowercase."
+4 IF '$TEST
SET DIR("?")="Enter the name of the board to be displayed on this computer; this value is case-sensitive."
+5 DO ^DIR
IF $GET(DTOUT)!$GET(DUOUT)
SET Y=""
+6 QUIT Y
+7 ;
SELECT() ; -- select item from list by number
+1 NEW X,Y,DIR,DTOUT,DUOUT
+2 SET DIR(0)="NAO^1:"_VALMCNT
SET DIR("A")="Select computer/board: "
+3 DO ^DIR
+4 QUIT Y
+5 ;
SURE(NAME) ; -- are you sure?
+1 NEW X,Y,DIR,DTOUT,DUOUT
WRITE !
+2 SET DIR("A",1)="Deletions are done immediately!"
+3 SET DIR(0)="YA"
SET DIR("A")="Are you sure"_$SELECT($LENGTH($GET(NAME)):" you want to remove "_NAME,1:"")_"? "
+4 DO ^DIR
+5 QUIT Y
+6 ;
+7 ; -- EDPF BIGBOARD MENU actions --
+8 ;
NEWDIV ; -- select new division
+1 NEW X
DO FULL^VALM1
SET VALMBCK="R"
+2 SET X=$$DIV
IF X
IF X'=EDPSITE
Begin DoDot:1
+3 WRITE !,"Rebuilding list ..."
HANG 1
+4 SET EDPSITE=X
DO INIT
+5 KILL VALMHDR
End DoDot:1
+6 QUIT
+7 ;
ADD ; -- add a computer/board
+1 NEW INST,VAL,DONE,EDPERR,MORE
+2 DO FULL^VALM1
SET VALMBCK="R"
WRITE !
+3 SET (DONE,MORE)=0
FOR
Begin DoDot:1
+4 SET INST=$$ENTER("Computer Name")
IF '$LENGTH(INST)
SET DONE=1
QUIT
+5 ;enforce lowercase
SET INST=$$LOW^XLFSTR(INST)
+6 SET VAL=$$ENTER("Display Board")
IF '$LENGTH(VAL)
SET DONE=1
QUIT
+7 DO ADD^XPAR("DIV.`"_EDPSITE,"EDPF BIGBOARD KIOSKS",INST,VAL,.EDPERR)
+8 IF EDPERR
WRITE !,$PIECE(EDPERR,U,2),!
HANG 2
QUIT
+9 SET MORE=1
WRITE !
End DoDot:1
if DONE
QUIT
+10 if MORE
DO INIT
+11 QUIT
+12 ;
REM ; -- remove a computer/board
+1 NEW NUM,INST,EDPERR
SET VALMBCK=""
+2 SET NUM=$$SELECT
if NUM<1
QUIT
+3 SET INST=$PIECE($GET(EDPB("IDX",NUM)),U)
+4 IF '$LENGTH(INST)
WRITE !,"Invalid selection"
HANG 1
QUIT
+5 if '$$SURE(INST)
QUIT
+6 DO DEL^XPAR("DIV.`"_EDPSITE,"EDPF BIGBOARD KIOSKS",INST,.EDPERR)
+7 IF EDPERR
WRITE !,$PIECE(EDPERR,U,2)
HANG 2
QUIT
+8 WRITE !,"Board removed."
HANG 1
+9 DO INIT
SET VALMBCK="R"
+10 QUIT
+11 ;
CHG ; -- change a computer or board name
+1 NEW NUM,OLD,INST,VAL,EDPERR
SET VALMBCK=""
+2 SET NUM=$$SELECT
if NUM<1
QUIT
+3 SET OLD=$GET(EDPB("IDX",NUM))
SET VALMBCK="R"
+4 SET INST=$$ENTER("Computer Name",$PIECE(OLD,U))
if '$LENGTH(INST)
QUIT
+5 ;enforce lowercase
SET INST=$$LOW^XLFSTR(INST)
+6 SET VAL=$$ENTER("Display Board",$PIECE(OLD,U,2))
if '$LENGTH(VAL)
QUIT
+7 ;no change
IF OLD=(INST_U_VAL)
QUIT
+8 IF INST'=$PIECE(OLD,U)
Begin DoDot:1
+9 DO REP^XPAR("DIV.`"_EDPSITE,"EDPF BIGBOARD KIOSKS",$PIECE(OLD,U),INST,.EDPERR)
+10 IF EDPERR
WRITE !,$PIECE(EDPERR,U,2)
HANG 2
End DoDot:1
if EDPERR
QUIT
+11 IF VAL'=$PIECE(OLD,U,2)
Begin DoDot:1
+12 DO CHG^XPAR("DIV.`"_EDPSITE,"EDPF BIGBOARD KIOSKS",INST,VAL,.EDPERR)
+13 IF EDPERR
WRITE !,$PIECE(EDPERR,U,2)
HANG 2
QUIT
End DoDot:1
+14 DO INIT
+15 QUIT
