FSCNAS ;SLC/STAFF NOIS Notification Alert Send ;1/11/98 18:41
;;1.1;NOIS;;Sep 06, 1998
;
ALERT(MSG) ; from FSCLMPNN
Q:'$D(MSG)
N DELIVERY,OK,RECIP,TYPE K ^TMP("FSCCALLS",$J),RECIP S OK=1
D
.D CALLS(.OK) I 'OK Q
.D TYPE(.TYPE,.OK) I 'OK Q
.I TYPE="OTHERS" D
..D RECIP(.RECIP,.OK)
..S DELIVERY=""
.E D
..S RECIP(DUZ)="" ;$$VALUE^FSCGET(DUZ,7100,2.1)
..D DELIVER(.DELIVERY,.OK)
.I 'OK Q
.D SEND(MSG,.RECIP,DELIVERY,.OK)
I 'OK W !!,"Alert was NOT sent."
E W !!,"Alert sent."
K ^TMP("FSCCALLS",$J),RECIP H 2
Q
;
CALLS(OK) ;
N CALL,CHOICE,DIR,LISTNUM,Y K DIR S OK=1
I '+@VALMAR Q
S DIR(0)="YAO",DIR("A")="Do you want to include "_$S($D(^TMP("FSC SELECT",$J,"EVALUES")):"this call",1:"calls")_" with the alert? ",DIR("B")="YES"
S DIR("?",1)="Enter YES to include calls with alert."
S DIR("?",2)="Enter NO to not include calls with the alert."
S DIR("?",3)="Enter '^' to exit without making changes or '??' for more help."
S DIR("?")="^D HELP^FSCU(.DIR)"
S DIR("??")="FSC U1 NOIS"
D ^DIR K DIR
I $D(DIRUT) S OK=0 Q
I Y D I 'OK Q
.D
..I $D(^TMP("FSC SELECT",$J,"EVALUES")) S CHOICE=FSCCNT_"-"_FSCCNT Q
..I $D(^TMP("FSC SELECT",$J,"VVALUES")) S CHOICE=^("VVALUES") Q
..S CHOICE="1-"_+@VALMAR
.D SELECT^FSCUL(CHOICE,"",CHOICE,"NVALUES",.OK)
.I 'OK Q
.S LISTNUM=0 F S LISTNUM=$O(^TMP("FSC SELECT",$J,"NVALUES",LISTNUM)) Q:LISTNUM<1 S CALL=$$CALL^FSCLMPE1(LISTNUM),^TMP("FSCCALLS",$J,CALL)=""
I $D(DIRUT) S OK=0 Q
Q
TYPE(TYPE,OK) ;
N DIR,Y K DIR S OK=1
S DIR(0)="SAMO^YOURSELF:YOURSELF;OTHERS:OTHERS",DIR("B")="OTHERS"
S DIR("A")="Will alert be sent to (Y)ourself or to (O)thers: "
S DIR("?",1)="Enter Y to send alert this alert to yourself at a later date."
S DIR("?",2)="Enter O to have alert sent to others immediately."
S DIR("?",3)="Note: Alerts sent to others can only be sent immediately."
S DIR("?",4)=" Alerts sent to yourself can be scheduled for later delivery."
S DIR("?")="^D HELP^FSCU(.DIR)"
S DIR("??")="FSC U1 NOIS"
D ^DIR K DIR
I $D(DIRUT) S OK=0 Q
S TYPE=Y
Q
;
RECIP(RECIP,OK) ;
N DEL,DIR,DONE,X,Y K DIR,RECIP S OK=1
S DIR(0)="FAO^1:32",DIR("A")="Send to: "
S DIR("?",1)="Enter the persons to whom you want to send alerts."
S DIR("?",2)="You can also enter mail groups."
S DIR("?",3)="Enter 'return' or '^' to exit, '??' for more help."
S DIR("?")="^D HELP^FSCU(.DIR)"
S DIR("??")="FSC U1 NOIS"
S DONE=0 F D Q:DONE
.D ^DIR
.I $D(DIRUT) S DONE=1 Q
.I '$L(Y) S DONE=1 Q
.S Y=$$UP^XLFSTR(Y)
.S DEL=0 I $E(Y)="-" S (X,Y)=$E(Y,2,245),DEL=1
.I '$L(Y) W " ??",$C(7) Q
.I DEL,'$D(RECIP) W " ??",$C(7) Q
.D
..I $E(Y,1,2)="G." D Q
...N DIC K DIC
...S X=$E(Y,3,99),DIC=3.8,DIC(0)="EMQ" D ^DIC K DIC I Y<1 Q
...I 'DEL S RECIP("G."_$P(Y,U,2))="" ;"G."_$P(Y,U,2)
...E D
....I $D(RECIP("G."_$P(Y,U,2))) K RECIP("G."_$P(Y,U,2)) W " Deleted."
....E W " ?? <not previously selected>",$C(7)
..N DIC K DIC
..S X=Y,DIC=200,DIC(0)="EMQ" D ^DIC K DIC I Y<1 Q
..I 'DEL S RECIP(+Y)="" ;$P(Y,U,2)
..E D
...I $D(RECIP(+Y))#2 K RECIP(+Y) W " Deleted."
...E W " ?? <not previously selected>",$C(7)
.S DIR("A")="And send to: "
K DIR I $D(DTOUT) S OK=0
I '$L($O(RECIP(0))) S OK=0
Q
;
DELIVER(DELIVERY,OK) ;
N DIR,FUTURE,LIMIT,Y K DIR S OK=1
S LIMIT=180,FUTURE=$$FMADD^XLFDT(DT,LIMIT)
S DIR(0)="DAO^DT:"_FUTURE_":EX",DIR("A")="Enter delivery date: ",DIR("B")="T"
S DIR("?",1)="Enter the delivery date for this alert."
S DIR("?",2)="This date can range from TODAY to T+"_LIMIT_" ("_$$FMTE^XLFDT(FUTURE)_")."
S DIR("?")="^D HELP^%DTC,HELP^FSCU(.DIR)"
S DIR("??")="FSC U1 NOIS"
D ^DIR K DIR
I $D(DIRUT) S OK=0 Q
S DELIVERY=Y
Q
;
SEND(XQAMSG,XQA,DELIVERY,OK) ;
N ALERT,CALL,DIR,XQADATA,XQAID,XQAROU,Y K DIR S OK=1
I $L(DELIVERY) S XQAMSG=XQAMSG_" from: Yourself, sent: "_$$FMTE^XLFDT(DT)
E S XQAMSG=XQAMSG_" from: "_$$VALUE^FSCGET(DUZ,7100,2.1)
I DELIVERY=DT S DELIVERY=""
S DIR(0)="YAO",DIR("A")="Send this alert? ",DIR("B")="YES"
S DIR("?",1)="Enter YES to send this alert."
S DIR("?",2)="Enter NO or '^' to exit or '??' for more help."
S DIR("?")="^D HELP^FSCU(.DIR)"
S DIR("??")="FSC U1 NOIS"
D ^DIR K DIR
I $D(DIRUT) S OK=0 Q
I Y'=1 S OK=0 Q
D NEWALERT^FSCNOTS(DUZ,,XQAMSG,.ALERT,DELIVERY)
S CALL=0 F S CALL=$O(^TMP("FSCCALLS",$J,CALL)) Q:CALL<1 D NEWSEND(ALERT,CALL)
I DELIVERY Q
S XQADATA=ALERT,XQAROU="ALERT^FSCNAR",XQAID="FSC-M"
D SETUP^XQALERT
Q
;
NEWSEND(ALERT,CALL) ; from FSCRPCN
N DA,DIK,NUM
S NUM=1+$P(^FSCD("SEND",0),U,3)
L +^FSCD("SEND",0):30 I '$T Q ; *** needs ok
F Q:'$D(^FSCD("SEND",NUM,0)) S NUM=NUM+1
S ^FSCD("SEND",NUM,0)=ALERT_U_CALL
S $P(^FSCD("SEND",0),U,3)=NUM,$P(^(0),U,4)=$P(^(0),U,4)+1
L -^FSCD("SEND",0)
S DIK="^FSCD(""SEND"",",DA=NUM D IX1^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCNAS 4844 printed Dec 13, 2024@02:18:45 Page 2
FSCNAS ;SLC/STAFF NOIS Notification Alert Send ;1/11/98 18:41
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
ALERT(MSG) ; from FSCLMPNN
+1 if '$DATA(MSG)
QUIT
+2 NEW DELIVERY,OK,RECIP,TYPE
KILL ^TMP("FSCCALLS",$JOB),RECIP
SET OK=1
+3 Begin DoDot:1
+4 DO CALLS(.OK)
IF 'OK
QUIT
+5 DO TYPE(.TYPE,.OK)
IF 'OK
QUIT
+6 IF TYPE="OTHERS"
Begin DoDot:2
+7 DO RECIP(.RECIP,.OK)
+8 SET DELIVERY=""
End DoDot:2
+9 IF '$TEST
Begin DoDot:2
+10 ;$$VALUE^FSCGET(DUZ,7100,2.1)
SET RECIP(DUZ)=""
+11 DO DELIVER(.DELIVERY,.OK)
End DoDot:2
+12 IF 'OK
QUIT
+13 DO SEND(MSG,.RECIP,DELIVERY,.OK)
End DoDot:1
+14 IF 'OK
WRITE !!,"Alert was NOT sent."
+15 IF '$TEST
WRITE !!,"Alert sent."
+16 KILL ^TMP("FSCCALLS",$JOB),RECIP
HANG 2
+17 QUIT
+18 ;
CALLS(OK) ;
+1 NEW CALL,CHOICE,DIR,LISTNUM,Y
KILL DIR
SET OK=1
+2 IF '+@VALMAR
QUIT
+3 SET DIR(0)="YAO"
SET DIR("A")="Do you want to include "_$SELECT($DATA(^TMP("FSC SELECT",$JOB,"EVALUES")):"this call",1:"calls")_" with the alert? "
SET DIR("B")="YES"
+4 SET DIR("?",1)="Enter YES to include calls with alert."
+5 SET DIR("?",2)="Enter NO to not include calls with the alert."
+6 SET DIR("?",3)="Enter '^' to exit without making changes or '??' for more help."
+7 SET DIR("?")="^D HELP^FSCU(.DIR)"
+8 SET DIR("??")="FSC U1 NOIS"
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)
SET OK=0
QUIT
+11 IF Y
Begin DoDot:1
+12 Begin DoDot:2
+13 IF $DATA(^TMP("FSC SELECT",$JOB,"EVALUES"))
SET CHOICE=FSCCNT_"-"_FSCCNT
QUIT
+14 IF $DATA(^TMP("FSC SELECT",$JOB,"VVALUES"))
SET CHOICE=^("VVALUES")
QUIT
+15 SET CHOICE="1-"_+@VALMAR
End DoDot:2
+16 DO SELECT^FSCUL(CHOICE,"",CHOICE,"NVALUES",.OK)
+17 IF 'OK
QUIT
+18 SET LISTNUM=0
FOR
SET LISTNUM=$ORDER(^TMP("FSC SELECT",$JOB,"NVALUES",LISTNUM))
if LISTNUM<1
QUIT
SET CALL=$$CALL^FSCLMPE1(LISTNUM)
SET ^TMP("FSCCALLS",$JOB,CALL)=""
End DoDot:1
IF 'OK
QUIT
+19 IF $DATA(DIRUT)
SET OK=0
QUIT
+20 QUIT
TYPE(TYPE,OK) ;
+1 NEW DIR,Y
KILL DIR
SET OK=1
+2 SET DIR(0)="SAMO^YOURSELF:YOURSELF;OTHERS:OTHERS"
SET DIR("B")="OTHERS"
+3 SET DIR("A")="Will alert be sent to (Y)ourself or to (O)thers: "
+4 SET DIR("?",1)="Enter Y to send alert this alert to yourself at a later date."
+5 SET DIR("?",2)="Enter O to have alert sent to others immediately."
+6 SET DIR("?",3)="Note: Alerts sent to others can only be sent immediately."
+7 SET DIR("?",4)=" Alerts sent to yourself can be scheduled for later delivery."
+8 SET DIR("?")="^D HELP^FSCU(.DIR)"
+9 SET DIR("??")="FSC U1 NOIS"
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
SET OK=0
QUIT
+12 SET TYPE=Y
+13 QUIT
+14 ;
RECIP(RECIP,OK) ;
+1 NEW DEL,DIR,DONE,X,Y
KILL DIR,RECIP
SET OK=1
+2 SET DIR(0)="FAO^1:32"
SET DIR("A")="Send to: "
+3 SET DIR("?",1)="Enter the persons to whom you want to send alerts."
+4 SET DIR("?",2)="You can also enter mail groups."
+5 SET DIR("?",3)="Enter 'return' or '^' to exit, '??' for more help."
+6 SET DIR("?")="^D HELP^FSCU(.DIR)"
+7 SET DIR("??")="FSC U1 NOIS"
+8 SET DONE=0
FOR
Begin DoDot:1
+9 DO ^DIR
+10 IF $DATA(DIRUT)
SET DONE=1
QUIT
+11 IF '$LENGTH(Y)
SET DONE=1
QUIT
+12 SET Y=$$UP^XLFSTR(Y)
+13 SET DEL=0
IF $EXTRACT(Y)="-"
SET (X,Y)=$EXTRACT(Y,2,245)
SET DEL=1
+14 IF '$LENGTH(Y)
WRITE " ??",$CHAR(7)
QUIT
+15 IF DEL
IF '$DATA(RECIP)
WRITE " ??",$CHAR(7)
QUIT
+16 Begin DoDot:2
+17 IF $EXTRACT(Y,1,2)="G."
Begin DoDot:3
+18 NEW DIC
KILL DIC
+19 SET X=$EXTRACT(Y,3,99)
SET DIC=3.8
SET DIC(0)="EMQ"
DO ^DIC
KILL DIC
IF Y<1
QUIT
+20 ;"G."_$P(Y,U,2)
IF 'DEL
SET RECIP("G."_$PIECE(Y,U,2))=""
+21 IF '$TEST
Begin DoDot:4
+22 IF $DATA(RECIP("G."_$PIECE(Y,U,2)))
KILL RECIP("G."_$PIECE(Y,U,2))
WRITE " Deleted."
+23 IF '$TEST
WRITE " ?? <not previously selected>",$CHAR(7)
End DoDot:4
End DoDot:3
QUIT
+24 NEW DIC
KILL DIC
+25 SET X=Y
SET DIC=200
SET DIC(0)="EMQ"
DO ^DIC
KILL DIC
IF Y<1
QUIT
+26 ;$P(Y,U,2)
IF 'DEL
SET RECIP(+Y)=""
+27 IF '$TEST
Begin DoDot:3
+28 IF $DATA(RECIP(+Y))#2
KILL RECIP(+Y)
WRITE " Deleted."
+29 IF '$TEST
WRITE " ?? <not previously selected>",$CHAR(7)
End DoDot:3
End DoDot:2
+30 SET DIR("A")="And send to: "
End DoDot:1
if DONE
QUIT
+31 KILL DIR
IF $DATA(DTOUT)
SET OK=0
+32 IF '$LENGTH($ORDER(RECIP(0)))
SET OK=0
+33 QUIT
+34 ;
DELIVER(DELIVERY,OK) ;
+1 NEW DIR,FUTURE,LIMIT,Y
KILL DIR
SET OK=1
+2 SET LIMIT=180
SET FUTURE=$$FMADD^XLFDT(DT,LIMIT)
+3 SET DIR(0)="DAO^DT:"_FUTURE_":EX"
SET DIR("A")="Enter delivery date: "
SET DIR("B")="T"
+4 SET DIR("?",1)="Enter the delivery date for this alert."
+5 SET DIR("?",2)="This date can range from TODAY to T+"_LIMIT_" ("_$$FMTE^XLFDT(FUTURE)_")."
+6 SET DIR("?")="^D HELP^%DTC,HELP^FSCU(.DIR)"
+7 SET DIR("??")="FSC U1 NOIS"
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
SET OK=0
QUIT
+10 SET DELIVERY=Y
+11 QUIT
+12 ;
SEND(XQAMSG,XQA,DELIVERY,OK) ;
+1 NEW ALERT,CALL,DIR,XQADATA,XQAID,XQAROU,Y
KILL DIR
SET OK=1
+2 IF $LENGTH(DELIVERY)
SET XQAMSG=XQAMSG_" from: Yourself, sent: "_$$FMTE^XLFDT(DT)
+3 IF '$TEST
SET XQAMSG=XQAMSG_" from: "_$$VALUE^FSCGET(DUZ,7100,2.1)
+4 IF DELIVERY=DT
SET DELIVERY=""
+5 SET DIR(0)="YAO"
SET DIR("A")="Send this alert? "
SET DIR("B")="YES"
+6 SET DIR("?",1)="Enter YES to send this alert."
+7 SET DIR("?",2)="Enter NO or '^' to exit or '??' for more help."
+8 SET DIR("?")="^D HELP^FSCU(.DIR)"
+9 SET DIR("??")="FSC U1 NOIS"
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
SET OK=0
QUIT
+12 IF Y'=1
SET OK=0
QUIT
+13 DO NEWALERT^FSCNOTS(DUZ,,XQAMSG,.ALERT,DELIVERY)
+14 SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSCCALLS",$JOB,CALL))
if CALL<1
QUIT
DO NEWSEND(ALERT,CALL)
+15 IF DELIVERY
QUIT
+16 SET XQADATA=ALERT
SET XQAROU="ALERT^FSCNAR"
SET XQAID="FSC-M"
+17 DO SETUP^XQALERT
+18 QUIT
+19 ;
NEWSEND(ALERT,CALL) ; from FSCRPCN
+1 NEW DA,DIK,NUM
+2 SET NUM=1+$PIECE(^FSCD("SEND",0),U,3)
+3 ; *** needs ok
LOCK +^FSCD("SEND",0):30
IF '$TEST
QUIT
+4 FOR
if '$DATA(^FSCD("SEND",NUM,0))
QUIT
SET NUM=NUM+1
+5 SET ^FSCD("SEND",NUM,0)=ALERT_U_CALL
+6 SET $PIECE(^FSCD("SEND",0),U,3)=NUM
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+7 LOCK -^FSCD("SEND",0)
+8 SET DIK="^FSCD(""SEND"","
SET DA=NUM
DO IX1^DIK
+9 QUIT
