TIUPSCS ;BPOIFO/EL/CR - TIU DOCUMENT POST-SIGNATURE ALERT SETUP ;10/29/17 8:15am
;;1.0;TEXT INTEGRATION UTILITIES;**305**;JUN 20, 1997;Build 27
;
; External Reference DBIA#:
; -------------------------
; #2056 - $$GET1^DIQ call (Supported)
; #6811 - Reference to file #100.21 (Private)
; #10006 - DIC call (Supported)
; #10026 - DIR call (Supported)
; #10060 - Reference to file 200 (Supported)
; #10111 - Reference to file 3.8 (Supported)
Q
;
BUILD ;
; allow a CAC to setup the title for post-signature alerts - a controlled situation
S ^TIU(8925.1,TIUIEN,4.9)=TIUDR
W !!,"The Post-Signature code for '"_$$GET1^DIQ(TIUFLE,TIUIEN,.01)_"' has been updated as follows..."
W !,"POST-SIGNATURE CODE: "_$$GET1^DIQ(TIUFLE,TIUIEN,4.9)
Q
;
CONFIRM ;
S (TIUDR,Y)=""
I TIUXQA=+TIUXQA S TIUDR="D EN^TIUPSCA("_TIUXQA_","""_$G(TIUSPEC)_""","""_$G(TIUDEV)_""")"
E S TIUDR="D EN^TIUPSCA("""_TIUXQA_""","""_$G(TIUSPEC)_""","""_$G(TIUDEV)_""")"
W !!,"The Post-Signature code for '"_TIUNAME_"' will be set as follows..."
W !,"POST-SIGNATURE CODE: "_TIUDR,!
S DIR("T")=TIUWAIT
S DIR(0)="Y"
S DIR("A")="Do you want to update Post-Signature Code into '"_TIUNAME_"'"
S DIR("B")="NO"
D ^DIR K DIR
I $D(DIRUT)!'$G(Y) D S TIUGO=0 Q
. W !!,"No action has been taken!!"
Q
;
DEL ; use to clean up an existing setup
S DIR("T")=TIUWAIT
S DIR(0)="Y"
S DIR("A")="Do you want to delete Post-Signature Code from '"_TIUNAME_"'"
S DIR("B")="NO"
D ^DIR K DIR
I $D(DIRUT)!'$G(Y) D S TIUGO=0 Q
. W !!,"No action has been taken!!"
; allow a CAC to delete a setup when needed - a controlled situation
S ^TIU(8925.1,TIUIEN,4.9)=""
W !,"... Deleted ..."
H 1
Q
;
DEVICE ;
W !
S (TIUDEV,Y)=""
S DIC=3.5,DIC(0)="AEMQ",DIC("A")="DEVICE NAME (Optional) for Paper Alert: "
D ^DIC K DIC
I $D(DUOUT)!$D(DTOUT) D S TIUGO=0 G DEVQ
. W !!,"ABORT DEVICE - No action is taken."
I $G(Y)>0 S TIUDEV=$P(Y,U,2)
DEVQ ;
Q
;
EN ; entry point for the option [TIUFPC CREATE POST-SIGNATURE]
N DA,DIROUT,DIRUT,DR,DTOUT,DUOUT
N H1,H2,I,J,STOP,TIUDEV,TIUFILE,TIUFLD,TIUFLE,TIUGO,TIUIE,TIUIEN
N TIUNAME,TIUPREV,TIURTN,TIUSPEC,TIUST,TIUWAIT,TIUWHO,TIUXQA
N X,Y,Z,Z1,Z2,ZZ,ZZIEN
;
S TIUWAIT=30
I $G(DTIME)'="" S TIUWAIT=DTIME
S TIUFLE=8925.1
S STOP=0,TIUGO=1
I '$D(U) S U="^"
;
EN10 ;
I $G(STOP)=1 Q
D INTRO
W ! D GETTITLE Q:$G(STOP)=1 I $G(TIUGO)=0 D STOP G EN10
W ! D WHO I $G(TIUGO)=0 D STOP G EN10
W ! D SUBROUT I $G(TIUGO)=0 D STOP G EN10
W ! D DEVICE I $G(TIUGO)=0 D STOP G EN10
W ! D CONFIRM I $G(TIUGO)=0 D STOP G EN10
W ! D BUILD D STOP
G EN10
;
GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE) ; Get field value
K ZZ S (Z,ZZIEN)=""
S ZZIEN=TIUIEN_","
D GETS^DIQ(TIUFLE,ZZIEN,TIUFLD,TIUIE,"ZZ")
S Z=$G(ZZ(TIUFLE,ZZIEN,TIUFLD,TIUIE))
Q $G(Z)
;
GETTITLE ;
S (TIUIEN,TIUNAME,Y)=""
S TIUGO=1
S DIC=TIUFLE,DIC(0)="AEMQ"
D ^DIC K DIC
I $G(Y)'>0!$D(DTOUT)!$D(DUOUT) S TIUGO=0,STOP=1 Q
S TIUIEN=+$G(Y),TIUNAME=$P(Y,U,2)
; lock the title to be updated, the lock is released at the end the setup at tag STOP
L +^TIU(TIUFLE,TIUIEN):1 E W !!,"Someone else is editing this record, try again later.",! S STOP=1 Q
; Check Class
S (TIUFLD,TIUIE,Z)=""
S TIUGO=1
S TIUFLD=.13,TIUIE="I"
S Z=$$GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE)
I +$G(Z)>0 D S TIUGO=0 Q
. W !!,"NATIONAL STANDARD Document Type cannot be edited."
S TIUFLD=.04,TIUIE="I"
S Z=$$GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE)
I $G(Z)'="DOC" D S TIUGO=0 Q
. W !!,"Only Document Title is allowed to be edited."
;
; Check Inherit
S (TIUPREV)=""
S TIUGO=1
S TIUPREV=$$POSTSIGN^TIULC1(TIUIEN)
I $G(TIUPREV)="" G STATUS
; once the title has been set up for the post-sig alert, get the closing ')'
; at the end of the parameters list
I $E(TIUPREV,$L(TIUPREV))'=")" D S TIUGO=0 Q
. W !!,"This application cannot alter more than one alert call at a time."
. W !,"It is --> ",TIUPREV
I $P(TIUPREV,"(")="D EN^TIUPSCA" D G STATUS
. W !!,"The POST-SIGNATURE Code in '"_TIUNAME_"' was created by this option."
. W !,"It is --> ",TIUPREV
. S DIR("A")="Do you want to change the Code? (YES or NO)"
. S DIR("T")=TIUWAIT
. S DIR(0)="Y"
. S DIR("B")="NO"
. W ! D ^DIR K DIR
. I $D(DIRUT)!($D(DTOUT))!('$G(Y)) S TIUGO=0
I $G(TIUPREV)]"" D S TIUGO=0 G STATUS
. W !!,"The POST-SIGNATURE Code in '"_TIUNAME_"' was already set by another option."
. W !,"It is --> ",TIUPREV
. W !,"This Post-Signature Code cannot be altered in this option."
. W !,"To change the code, please contact your local IT Support Programmer."
. W !,"'Document Definitions (Manager) / Edit Document' option can be used."
;
STATUS ; Check
I TIUGO=0 Q
S (TIUFLD,TIUIE,TIUST,Y,Z)=""
S TIUFLD=.07,TIUIE="I"
S Z=$$GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE),TIUST=$G(Z)
I $G(Z)=11 Q
S TIUIE="E",Z=$$GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE),TIUST=$G(Z)
W !!,"The STATUS of this Document Definition Title is '"_TIUST_"'."
S DIR("A")="Do you want to continue with this title: '"_TIUNAME_"'"
S DIR("T")=TIUWAIT
S DIR(0)="Y"
S DIR("B")="NO"
W ! D ^DIR K DIR
I $D(DIRUT)!('$G(Y)) S TIUGO=0 Q
Q
;
INTRO ;
W @IOF
W !,"This option will setup 'Post-Signature Code Alerts' for PROGRESS NOTES."
W !,"Please select a choice of RECIPIENTS, and a choice of ROUTINE,"
W !,"and DEVICE (optional) to receive a printed alert upon note signature."
W !!,"If both RECIPIENTS and ROUTINE are N/A, a choice of"
W !,"DELETION or CANCELLATION for the Code Alert setting will be provided.",!!
S (DA,DIC,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT)=""
S (H1,H2,I,J,STOP,TIUDEV,TIUFILE,TIUFLD,TIUGO,TIUIE,TIUIEN)=""
S (TIUNAME,TIUPREV,TIURTN,TIUSPEC,TIUST,TIUWHO,TIUXQA)=""
S (X,Y,Z,Z1,Z2,ZZ,ZZIEN)=""
;
HD ; Header for Enter Post-Signature Code
S STOP=0,TIUGO=1
S (H1,H2,I)=""
S H1="Enter Post-Signature Code for Alert"
F I=1:1:$L(H1) S H2=H2_"="
I $G(IOM)="" S IOM=76
S X=(IOM-$L(H1))/2
W ! F I=1:1:X W " "
W H1,! F I=1:1:X W " "
W H2
Q
;
STOP ; Check Continue
S X="",STOP=0
S X="Enter <RETURN> for another TIU Document Definition Name or "
S X=X_"'^' to exit: "
W !!,X R Y:TIUWAIT S:'$T Y=U
I $G(Y)=U S STOP=1,TIUGO=0
L -^TIU(TIUFLE,TIUIEN)
Q
;
SUBROUT ;
K TIUARY,TIURTN
S (I,J,TIUARY,TIURTN,TIUSPEC,Y,Z,Z1,Z2)=""
S DIR("T")=TIUWAIT
S DIR("A")="Choose an alert ROUTINE from the above listing"
S TIUARY=$$GETRTN^TIUPSCA(.TIUARY)
F I=1:1 Q:$G(TIUARY(I))="" D S DIR("A",I)=I_") "_TIURTN(I)
. S Z="",Z=TIUARY(I)
. S (J,Z1,Z2)=""
. S Z1=$P(Z,"-"),Z2=$P(Z,"-",2) F J=1:1:9-$L(Z1) ; S Z1=Z1_" "
. S TIURTN(I)=Z1_"- "_Z2
S DIR("A",I)="",J=I-1
S DIR(0)="NO^1:"_J
D ^DIR K DIR
I $D(DIRUT) D S TIUGO=0 G SUBQ
. W !!,"ABORT alert ROUTINE - No action is taken."
I $G(Y)="" W !!,"This is a required response. OR Enter '^' to exit",! H 1 G SUBROUT
I $G(Y)=1 S TIUSPEC=""
E S Z=$G(TIUARY(Y)),TIUSPEC=$P(Z,"-")
I $G(TIUXQA)="",$G(TIUSPEC)="",$G(TIUPREV)="" D S TIUGO=0 G SUBQ
. W !!,"Without RECIPIENT and ROUTINE, alert code setting is cancelled." H 1
I $G(TIUXQA)="",$G(TIUSPEC)="",$G(TIUPREV)'="" D G SUBQ
. S DIR("A")="W/O RECIPIENT and ROUTINE, ALERT CODE will be deleted? (YES or NO)"
. S DIR("T")=TIUWAIT
. S DIR(0)="Y"
. S DIR("B")="NO"
. W ! D ^DIR K DIR
. I $D(DIRUT)!'$G(Y) D S TIUGO=0 Q
. . W !!,"No action has been taken!!" S TIUGO=0
. S TIUGO=0 D DEL Q
SUBQ Q
;
WHO ; Select Alert Recipient
S (TIUWHO,Y)=""
S DIR(0)="S^N:N/A;I:INDIVIDUAL USER;G:MAILGROUP;T:TEAM LIST (OE/RR with Queued Alert)"
S DIR("A")="Choose RECIPIENTS to receive the alert (N/I/G/T) or '^' to exit"
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT)) S TIUGO=0 Q ;G STOP
S TIUWHO=$G(Y)
; XQA set up
S (TIUFILE,TIUXQA,Y)=""
S TIUFILE=$S(TIUWHO="I":200,TIUWHO="G":3.8,TIUWHO="T":100.21,1:"")
S DIC=TIUFILE
S DIC(0)="AEMQ"
D ^DIC K DIC
I $G(Y)'>0 S TIUXQA=""
E S TIUXQA=$S(TIUWHO="I":+Y,1:TIUWHO_"."_$$GET1^DIQ(TIUFILE,+Y,.01))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPSCS 8014 printed Apr 09, 2024@21:43:23 Page 2
TIUPSCS ;BPOIFO/EL/CR - TIU DOCUMENT POST-SIGNATURE ALERT SETUP ;10/29/17 8:15am
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**305**;JUN 20, 1997;Build 27
+2 ;
+3 ; External Reference DBIA#:
+4 ; -------------------------
+5 ; #2056 - $$GET1^DIQ call (Supported)
+6 ; #6811 - Reference to file #100.21 (Private)
+7 ; #10006 - DIC call (Supported)
+8 ; #10026 - DIR call (Supported)
+9 ; #10060 - Reference to file 200 (Supported)
+10 ; #10111 - Reference to file 3.8 (Supported)
+11 QUIT
+12 ;
BUILD ;
+1 ; allow a CAC to setup the title for post-signature alerts - a controlled situation
+2 SET ^TIU(8925.1,TIUIEN,4.9)=TIUDR
+3 WRITE !!,"The Post-Signature code for '"_$$GET1^DIQ(TIUFLE,TIUIEN,.01)_"' has been updated as follows..."
+4 WRITE !,"POST-SIGNATURE CODE: "_$$GET1^DIQ(TIUFLE,TIUIEN,4.9)
+5 QUIT
+6 ;
CONFIRM ;
+1 SET (TIUDR,Y)=""
+2 IF TIUXQA=+TIUXQA
SET TIUDR="D EN^TIUPSCA("_TIUXQA_","""_$GET(TIUSPEC)_""","""_$GET(TIUDEV)_""")"
+3 IF '$TEST
SET TIUDR="D EN^TIUPSCA("""_TIUXQA_""","""_$GET(TIUSPEC)_""","""_$GET(TIUDEV)_""")"
+4 WRITE !!,"The Post-Signature code for '"_TIUNAME_"' will be set as follows..."
+5 WRITE !,"POST-SIGNATURE CODE: "_TIUDR,!
+6 SET DIR("T")=TIUWAIT
+7 SET DIR(0)="Y"
+8 SET DIR("A")="Do you want to update Post-Signature Code into '"_TIUNAME_"'"
+9 SET DIR("B")="NO"
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)!'$GET(Y)
Begin DoDot:1
+12 WRITE !!,"No action has been taken!!"
End DoDot:1
SET TIUGO=0
QUIT
+13 QUIT
+14 ;
DEL ; use to clean up an existing setup
+1 SET DIR("T")=TIUWAIT
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Do you want to delete Post-Signature Code from '"_TIUNAME_"'"
+4 SET DIR("B")="NO"
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)!'$GET(Y)
Begin DoDot:1
+7 WRITE !!,"No action has been taken!!"
End DoDot:1
SET TIUGO=0
QUIT
+8 ; allow a CAC to delete a setup when needed - a controlled situation
+9 SET ^TIU(8925.1,TIUIEN,4.9)=""
+10 WRITE !,"... Deleted ..."
+11 HANG 1
+12 QUIT
+13 ;
DEVICE ;
+1 WRITE !
+2 SET (TIUDEV,Y)=""
+3 SET DIC=3.5
SET DIC(0)="AEMQ"
SET DIC("A")="DEVICE NAME (Optional) for Paper Alert: "
+4 DO ^DIC
KILL DIC
+5 IF $DATA(DUOUT)!$DATA(DTOUT)
Begin DoDot:1
+6 WRITE !!,"ABORT DEVICE - No action is taken."
End DoDot:1
SET TIUGO=0
GOTO DEVQ
+7 IF $GET(Y)>0
SET TIUDEV=$PIECE(Y,U,2)
DEVQ ;
+1 QUIT
+2 ;
EN ; entry point for the option [TIUFPC CREATE POST-SIGNATURE]
+1 NEW DA,DIROUT,DIRUT,DR,DTOUT,DUOUT
+2 NEW H1,H2,I,J,STOP,TIUDEV,TIUFILE,TIUFLD,TIUFLE,TIUGO,TIUIE,TIUIEN
+3 NEW TIUNAME,TIUPREV,TIURTN,TIUSPEC,TIUST,TIUWAIT,TIUWHO,TIUXQA
+4 NEW X,Y,Z,Z1,Z2,ZZ,ZZIEN
+5 ;
+6 SET TIUWAIT=30
+7 IF $GET(DTIME)'=""
SET TIUWAIT=DTIME
+8 SET TIUFLE=8925.1
+9 SET STOP=0
SET TIUGO=1
+10 IF '$DATA(U)
SET U="^"
+11 ;
EN10 ;
+1 IF $GET(STOP)=1
QUIT
+2 DO INTRO
+3 WRITE !
DO GETTITLE
if $GET(STOP)=1
QUIT
IF $GET(TIUGO)=0
DO STOP
GOTO EN10
+4 WRITE !
DO WHO
IF $GET(TIUGO)=0
DO STOP
GOTO EN10
+5 WRITE !
DO SUBROUT
IF $GET(TIUGO)=0
DO STOP
GOTO EN10
+6 WRITE !
DO DEVICE
IF $GET(TIUGO)=0
DO STOP
GOTO EN10
+7 WRITE !
DO CONFIRM
IF $GET(TIUGO)=0
DO STOP
GOTO EN10
+8 WRITE !
DO BUILD
DO STOP
+9 GOTO EN10
+10 ;
GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE) ; Get field value
+1 KILL ZZ
SET (Z,ZZIEN)=""
+2 SET ZZIEN=TIUIEN_","
+3 DO GETS^DIQ(TIUFLE,ZZIEN,TIUFLD,TIUIE,"ZZ")
+4 SET Z=$GET(ZZ(TIUFLE,ZZIEN,TIUFLD,TIUIE))
+5 QUIT $GET(Z)
+6 ;
GETTITLE ;
+1 SET (TIUIEN,TIUNAME,Y)=""
+2 SET TIUGO=1
+3 SET DIC=TIUFLE
SET DIC(0)="AEMQ"
+4 DO ^DIC
KILL DIC
+5 IF $GET(Y)'>0!$DATA(DTOUT)!$DATA(DUOUT)
SET TIUGO=0
SET STOP=1
QUIT
+6 SET TIUIEN=+$GET(Y)
SET TIUNAME=$PIECE(Y,U,2)
+7 ; lock the title to be updated, the lock is released at the end the setup at tag STOP
+8 LOCK +^TIU(TIUFLE,TIUIEN):1
IF '$TEST
WRITE !!,"Someone else is editing this record, try again later.",!
SET STOP=1
QUIT
+9 ; Check Class
+10 SET (TIUFLD,TIUIE,Z)=""
+11 SET TIUGO=1
+12 SET TIUFLD=.13
SET TIUIE="I"
+13 SET Z=$$GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE)
+14 IF +$GET(Z)>0
Begin DoDot:1
+15 WRITE !!,"NATIONAL STANDARD Document Type cannot be edited."
End DoDot:1
SET TIUGO=0
QUIT
+16 SET TIUFLD=.04
SET TIUIE="I"
+17 SET Z=$$GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE)
+18 IF $GET(Z)'="DOC"
Begin DoDot:1
+19 WRITE !!,"Only Document Title is allowed to be edited."
End DoDot:1
SET TIUGO=0
QUIT
+20 ;
+21 ; Check Inherit
+22 SET (TIUPREV)=""
+23 SET TIUGO=1
+24 SET TIUPREV=$$POSTSIGN^TIULC1(TIUIEN)
+25 IF $GET(TIUPREV)=""
GOTO STATUS
+26 ; once the title has been set up for the post-sig alert, get the closing ')'
+27 ; at the end of the parameters list
+28 IF $EXTRACT(TIUPREV,$LENGTH(TIUPREV))'=")"
Begin DoDot:1
+29 WRITE !!,"This application cannot alter more than one alert call at a time."
+30 WRITE !,"It is --> ",TIUPREV
End DoDot:1
SET TIUGO=0
QUIT
+31 IF $PIECE(TIUPREV,"(")="D EN^TIUPSCA"
Begin DoDot:1
+32 WRITE !!,"The POST-SIGNATURE Code in '"_TIUNAME_"' was created by this option."
+33 WRITE !,"It is --> ",TIUPREV
+34 SET DIR("A")="Do you want to change the Code? (YES or NO)"
+35 SET DIR("T")=TIUWAIT
+36 SET DIR(0)="Y"
+37 SET DIR("B")="NO"
+38 WRITE !
DO ^DIR
KILL DIR
+39 IF $DATA(DIRUT)!($DATA(DTOUT))!('$GET(Y))
SET TIUGO=0
End DoDot:1
GOTO STATUS
+40 IF $GET(TIUPREV)]""
Begin DoDot:1
+41 WRITE !!,"The POST-SIGNATURE Code in '"_TIUNAME_"' was already set by another option."
+42 WRITE !,"It is --> ",TIUPREV
+43 WRITE !,"This Post-Signature Code cannot be altered in this option."
+44 WRITE !,"To change the code, please contact your local IT Support Programmer."
+45 WRITE !,"'Document Definitions (Manager) / Edit Document' option can be used."
End DoDot:1
SET TIUGO=0
GOTO STATUS
+46 ;
STATUS ; Check
+1 IF TIUGO=0
QUIT
+2 SET (TIUFLD,TIUIE,TIUST,Y,Z)=""
+3 SET TIUFLD=.07
SET TIUIE="I"
+4 SET Z=$$GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE)
SET TIUST=$GET(Z)
+5 IF $GET(Z)=11
QUIT
+6 SET TIUIE="E"
SET Z=$$GETFLD(TIUFLE,TIUIEN,TIUFLD,TIUIE)
SET TIUST=$GET(Z)
+7 WRITE !!,"The STATUS of this Document Definition Title is '"_TIUST_"'."
+8 SET DIR("A")="Do you want to continue with this title: '"_TIUNAME_"'"
+9 SET DIR("T")=TIUWAIT
+10 SET DIR(0)="Y"
+11 SET DIR("B")="NO"
+12 WRITE !
DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)!('$GET(Y))
SET TIUGO=0
QUIT
+14 QUIT
+15 ;
INTRO ;
+1 WRITE @IOF
+2 WRITE !,"This option will setup 'Post-Signature Code Alerts' for PROGRESS NOTES."
+3 WRITE !,"Please select a choice of RECIPIENTS, and a choice of ROUTINE,"
+4 WRITE !,"and DEVICE (optional) to receive a printed alert upon note signature."
+5 WRITE !!,"If both RECIPIENTS and ROUTINE are N/A, a choice of"
+6 WRITE !,"DELETION or CANCELLATION for the Code Alert setting will be provided.",!!
+7 SET (DA,DIC,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT)=""
+8 SET (H1,H2,I,J,STOP,TIUDEV,TIUFILE,TIUFLD,TIUGO,TIUIE,TIUIEN)=""
+9 SET (TIUNAME,TIUPREV,TIURTN,TIUSPEC,TIUST,TIUWHO,TIUXQA)=""
+10 SET (X,Y,Z,Z1,Z2,ZZ,ZZIEN)=""
+11 ;
HD ; Header for Enter Post-Signature Code
+1 SET STOP=0
SET TIUGO=1
+2 SET (H1,H2,I)=""
+3 SET H1="Enter Post-Signature Code for Alert"
+4 FOR I=1:1:$LENGTH(H1)
SET H2=H2_"="
+5 IF $GET(IOM)=""
SET IOM=76
+6 SET X=(IOM-$LENGTH(H1))/2
+7 WRITE !
FOR I=1:1:X
WRITE " "
+8 WRITE H1,!
FOR I=1:1:X
WRITE " "
+9 WRITE H2
+10 QUIT
+11 ;
STOP ; Check Continue
+1 SET X=""
SET STOP=0
+2 SET X="Enter <RETURN> for another TIU Document Definition Name or "
+3 SET X=X_"'^' to exit: "
+4 WRITE !!,X
READ Y:TIUWAIT
if '$TEST
SET Y=U
+5 IF $GET(Y)=U
SET STOP=1
SET TIUGO=0
+6 LOCK -^TIU(TIUFLE,TIUIEN)
+7 QUIT
+8 ;
SUBROUT ;
+1 KILL TIUARY,TIURTN
+2 SET (I,J,TIUARY,TIURTN,TIUSPEC,Y,Z,Z1,Z2)=""
+3 SET DIR("T")=TIUWAIT
+4 SET DIR("A")="Choose an alert ROUTINE from the above listing"
+5 SET TIUARY=$$GETRTN^TIUPSCA(.TIUARY)
+6 FOR I=1:1
if $GET(TIUARY(I))=""
QUIT
Begin DoDot:1
+7 SET Z=""
SET Z=TIUARY(I)
+8 SET (J,Z1,Z2)=""
+9 ; S Z1=Z1_" "
SET Z1=$PIECE(Z,"-")
SET Z2=$PIECE(Z,"-",2)
FOR J=1:1:9-$LENGTH(Z1)
+10 SET TIURTN(I)=Z1_"- "_Z2
End DoDot:1
SET DIR("A",I)=I_") "_TIURTN(I)
+11 SET DIR("A",I)=""
SET J=I-1
+12 SET DIR(0)="NO^1:"_J
+13 DO ^DIR
KILL DIR
+14 IF $DATA(DIRUT)
Begin DoDot:1
+15 WRITE !!,"ABORT alert ROUTINE - No action is taken."
End DoDot:1
SET TIUGO=0
GOTO SUBQ
+16 IF $GET(Y)=""
WRITE !!,"This is a required response. OR Enter '^' to exit",!
HANG 1
GOTO SUBROUT
+17 IF $GET(Y)=1
SET TIUSPEC=""
+18 IF '$TEST
SET Z=$GET(TIUARY(Y))
SET TIUSPEC=$PIECE(Z,"-")
+19 IF $GET(TIUXQA)=""
IF $GET(TIUSPEC)=""
IF $GET(TIUPREV)=""
Begin DoDot:1
+20 WRITE !!,"Without RECIPIENT and ROUTINE, alert code setting is cancelled."
HANG 1
End DoDot:1
SET TIUGO=0
GOTO SUBQ
+21 IF $GET(TIUXQA)=""
IF $GET(TIUSPEC)=""
IF $GET(TIUPREV)'=""
Begin DoDot:1
+22 SET DIR("A")="W/O RECIPIENT and ROUTINE, ALERT CODE will be deleted? (YES or NO)"
+23 SET DIR("T")=TIUWAIT
+24 SET DIR(0)="Y"
+25 SET DIR("B")="NO"
+26 WRITE !
DO ^DIR
KILL DIR
+27 IF $DATA(DIRUT)!'$GET(Y)
Begin DoDot:2
+28 WRITE !!,"No action has been taken!!"
SET TIUGO=0
End DoDot:2
SET TIUGO=0
QUIT
+29 SET TIUGO=0
DO DEL
QUIT
End DoDot:1
GOTO SUBQ
SUBQ QUIT
+1 ;
WHO ; Select Alert Recipient
+1 SET (TIUWHO,Y)=""
+2 SET DIR(0)="S^N:N/A;I:INDIVIDUAL USER;G:MAILGROUP;T:TEAM LIST (OE/RR with Queued Alert)"
+3 SET DIR("A")="Choose RECIPIENTS to receive the alert (N/I/G/T) or '^' to exit"
+4 DO ^DIR
KILL DIR
+5 ;G STOP
IF $DATA(DTOUT)!($DATA(DUOUT))
SET TIUGO=0
QUIT
+6 SET TIUWHO=$GET(Y)
+7 ; XQA set up
+8 SET (TIUFILE,TIUXQA,Y)=""
+9 SET TIUFILE=$SELECT(TIUWHO="I":200,TIUWHO="G":3.8,TIUWHO="T":100.21,1:"")
+10 SET DIC=TIUFILE
+11 SET DIC(0)="AEMQ"
+12 DO ^DIC
KILL DIC
+13 IF $GET(Y)'>0
SET TIUXQA=""
+14 IF '$TEST
SET TIUXQA=$SELECT(TIUWHO="I":+Y,1:TIUWHO_"."_$$GET1^DIQ(TIUFILE,+Y,.01))
+15 QUIT
