- 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 Feb 18, 2025@23:45:12 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
