XQALMAKE ;ISC-SF.SEA/JLI- HIGH LEVEL SETUP ALERT ;4/9/07 14:03
;;8.0;KERNEL;**443,602**;Jul 10, 1995;Build 9
;Per VHA Directive 2004-038, this routine should not be modified
;;
ENTRY ;
W !!,"ALERT GENERATOR"
TEXT K XQA,XQAMSG,XQAOPT,XQAROU,DIC,DIR
R !!,"ON THE NEXT LINE ENTER THE TEXT TO BE DISPLAYED FOR THE ALERT ___",!,X:DTIME G:'$T!(X[U)!(X="") EXIT W !!,X S XQALX=X,DIR(0)="Y",DIR("A")="Is this text OK? ",DIR("B")="YES" D ^DIR K DIR G:'Y TEXT S XQAMSG=XQALX
D LOOP1 G:'$D(XQA) EXIT
ASKOPT S DIR(0)="Y",DIR("A")="Do you want to transfer control to an option when the alert is selected" D ^DIR K DIR I Y D GETOPT G:Y'="" SETIT G ASKOPT
ASKROU S DIR(0)="Y",DIR("A")="Do you want to transfer control to a routine when the alert is selected" D ^DIR K DIR G:'Y SETIT
R !,"Enter ROUTINE name or ENTRY^ROUTINE name: ",X:DTIME S:'$T X=U G:X=U EXIT G:X="" ASKROU S XQAROU=X S X=$S(X'[U:X,1:$P(X,U,2)) G:X="" ASKROU X ^%ZOSF("TEST") I 'Y W !,"Routine '",X,"' not present" G ASKROU
SETIT ;
I '$D(XQAROU),'$D(XQAOPT) S DIR(0)="Y",DIR("A")="Do you want to make a long text info only alert" D ^DIR K DIR I Y D LONGTEXT
W !!,"As currently entered, this alert will display the following text:",!!,XQAMSG
W !!,"The alert is currently to be delivered to:" S XQAX="" F I=1:1 S XQAX=$O(XQA(XQAX)) Q:XQAX="" S X=$S(XQAX>0:$P(^VA(200,XQAX,0),U),1:XQAX) W:(I#2) ! W:'(I#2) ?40 W X
W:$D(XQAROU) !!,"On selection of the alert, the user will run the routine ",XQAROU W:$D(XQAOPT) !!,"On selection of the alert, the user will be taken to the",!,"the option ",XQAOPT W !!
S DIR(0)="Y",DIR("A")="Is this alert what was intended",DIR("B")="YES" D ^DIR K DIR I 'Y G ENTRY
D SETUP^XQALERT
W !!?20,"ALERT IS NOW SET",!!
G ENTRY
;
GETOPT ;
S DIC=19,DIC(0)="AEQM",DIC("A")="Indicate the desired OPTION: " D ^DIC K DIC S:Y'>0 Y="" S XQAOPT=$P(Y,U,2)
Q
;
EXIT ;
K XQALDIC,XQALX,XQA,XQAMSG,XQAOPT,XQAROU,DIC,DIR,X,Y
Q
LOOP1 K XQA R !,"Enter a User name or G.mailgroup",!,"as recipient of the Alert: ",X:DTIME S:'$T!(X="") X=U I X'[U D SETONE G:Y'>0 LOOP1
I X'[U F R !,"Enter another user or G.mailgroup: ",X:DTIME S:'$T X=U Q:X[U!(X="") D SETONE
K:X[U XQA Q
SETONE ;
S XQALDIC=$S("g.G."[$E(X,1,2):3.8,1:200),X=$S(XQALDIC=3.8:$E(X,3,$L(X)),1:X),DIC=XQALDIC,DIC(0)="EMQ" D ^DIC Q:Y'>0 S X=$S(XQALDIC=3.8:"G."_$P(Y,U,2),1:+Y),XQA(X)=""
Q
;
LONGTEXT ;
W !,"Enter .EXIT to terminate input",!
S COUNT="" F R X:DTIME Q:X=".EXIT" S COUNT=COUNT+1,XQATEXT(COUNT)=X W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQALMAKE 2507 printed Dec 13, 2024@02:05:26 Page 2
XQALMAKE ;ISC-SF.SEA/JLI- HIGH LEVEL SETUP ALERT ;4/9/07 14:03
+1 ;;8.0;KERNEL;**443,602**;Jul 10, 1995;Build 9
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ;;
ENTRY ;
+1 WRITE !!,"ALERT GENERATOR"
TEXT KILL XQA,XQAMSG,XQAOPT,XQAROU,DIC,DIR
+1 READ !!,"ON THE NEXT LINE ENTER THE TEXT TO BE DISPLAYED FOR THE ALERT ___",!,X:DTIME
if '$TEST!(X[U)!(X="")
GOTO EXIT
WRITE !!,X
SET XQALX=X
SET DIR(0)="Y"
SET DIR("A")="Is this text OK? "
SET DIR("B")="YES"
DO ^DIR
KILL DIR
if 'Y
GOTO TEXT
SET XQAMSG=XQALX
+2 DO LOOP1
if '$DATA(XQA)
GOTO EXIT
ASKOPT SET DIR(0)="Y"
SET DIR("A")="Do you want to transfer control to an option when the alert is selected"
DO ^DIR
KILL DIR
IF Y
DO GETOPT
if Y'=""
GOTO SETIT
GOTO ASKOPT
ASKROU SET DIR(0)="Y"
SET DIR("A")="Do you want to transfer control to a routine when the alert is selected"
DO ^DIR
KILL DIR
if 'Y
GOTO SETIT
+1 READ !,"Enter ROUTINE name or ENTRY^ROUTINE name: ",X:DTIME
if '$TEST
SET X=U
if X=U
GOTO EXIT
if X=""
GOTO ASKROU
SET XQAROU=X
SET X=$SELECT(X'[U:X,1:$PIECE(X,U,2))
if X=""
GOTO ASKROU
XECUTE ^%ZOSF("TEST")
IF 'Y
WRITE !,"Routine '",X,"' not present"
GOTO ASKROU
SETIT ;
+1 IF '$DATA(XQAROU)
IF '$DATA(XQAOPT)
SET DIR(0)="Y"
SET DIR("A")="Do you want to make a long text info only alert"
DO ^DIR
KILL DIR
IF Y
DO LONGTEXT
+2 WRITE !!,"As currently entered, this alert will display the following text:",!!,XQAMSG
+3 WRITE !!,"The alert is currently to be delivered to:"
SET XQAX=""
FOR I=1:1
SET XQAX=$ORDER(XQA(XQAX))
if XQAX=""
QUIT
SET X=$SELECT(XQAX>0:$PIECE(^VA(200,XQAX,0),U),1:XQAX)
if (I#2)
WRITE !
if '(I#2)
WRITE ?40
WRITE X
+4 if $DATA(XQAROU)
WRITE !!,"On selection of the alert, the user will run the routine ",XQAROU
if $DATA(XQAOPT)
WRITE !!,"On selection of the alert, the user will be taken to the",!,"the option ",XQAOPT
WRITE !!
+5 SET DIR(0)="Y"
SET DIR("A")="Is this alert what was intended"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
IF 'Y
GOTO ENTRY
+6 DO SETUP^XQALERT
+7 WRITE !!?20,"ALERT IS NOW SET",!!
+8 GOTO ENTRY
+9 ;
GETOPT ;
+1 SET DIC=19
SET DIC(0)="AEQM"
SET DIC("A")="Indicate the desired OPTION: "
DO ^DIC
KILL DIC
if Y'>0
SET Y=""
SET XQAOPT=$PIECE(Y,U,2)
+2 QUIT
+3 ;
EXIT ;
+1 KILL XQALDIC,XQALX,XQA,XQAMSG,XQAOPT,XQAROU,DIC,DIR,X,Y
+2 QUIT
LOOP1 KILL XQA
READ !,"Enter a User name or G.mailgroup",!,"as recipient of the Alert: ",X:DTIME
if '$TEST!(X="")
SET X=U
IF X'[U
DO SETONE
if Y'>0
GOTO LOOP1
+1 IF X'[U
FOR
READ !,"Enter another user or G.mailgroup: ",X:DTIME
if '$TEST
SET X=U
if X[U!(X="")
QUIT
DO SETONE
+2 if X[U
KILL XQA
QUIT
SETONE ;
+1 SET XQALDIC=$SELECT("g.G."[$EXTRACT(X,1,2):3.8,1:200)
SET X=$SELECT(XQALDIC=3.8:$EXTRACT(X,3,$LENGTH(X)),1:X)
SET DIC=XQALDIC
SET DIC(0)="EMQ"
DO ^DIC
if Y'>0
QUIT
SET X=$SELECT(XQALDIC=3.8:"G."_$PIECE(Y,U,2),1:+Y)
SET XQA(X)=""
+2 QUIT
+3 ;
LONGTEXT ;
+1 WRITE !,"Enter .EXIT to terminate input",!
+2 SET COUNT=""
FOR
READ X:DTIME
if X=".EXIT"
QUIT
SET COUNT=COUNT+1
SET XQATEXT(COUNT)=X
WRITE !
+3 QUIT
