- 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 Feb 18, 2025@23:31:52 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