FSCSTU ;SLC/STAFF-NOIS Site Tracking Update ;1/17/98 16:51
;;1.1;NOIS;;Sep 06, 1998
;
UPDATE(MSG,PACKAGE,SITE,DATE) ; from A5CSTS
N VAR,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE K ZTSAVE
S ZTIO=$$RESOURCE^FSCTASK($$DOW^XLFDT(DT,1)+1),ZTRTN="SETUP^FSCSTU",ZTDTH=$H,ZTDESC="NOIS Site Tracking Updates"
F VAR="MSG(","PACKAGE","SITE","DATE" S ZTSAVE(VAR)=""
D ^%ZTLOAD
Q
;
SETUP ; dequeued
I $D(ZTQUEUED) S ZTREQ="@"
Q:'$G(DATE) Q:'$L($G(PACKAGE)) Q:'$L($G(SITE)) Q:'$O(MSG(0))
N DA,DIK,MSGNUM,NUM,PACKNUM,SITENUM
; convert date, official package name, and domain for NOIS
S DATE=DATE\1
S PACKNUM=+$O(^DIC(9.4,"B",PACKAGE,0)),PACKAGE=+$O(^FSC("PACK","AC",PACKNUM,0))
S SITENUM=+$O(^DIC(4.2,"B",SITE,0)),SITE=+$O(^FSC("SITE","AE",SITENUM,0))
S MSGNUM=+$O(MSG(""),-1)
Q:'DATE Q:'PACKAGE Q:'SITE Q:'MSGNUM
;
; setup msg
S NUM=1+$P(^FSCD("STU MSG",0),U,3)
L +^FSCD("STU MSG",0):30 I '$T Q ; *** skip
F Q:'$D(^FSCD("STU MSG",NUM,0)) S NUM=NUM+1
S ^FSCD("STU MSG",NUM,0)=DATE_U_PACKAGE_U_SITE
S $P(^FSCD("STU MSG",0),U,3)=NUM,$P(^(0),U,4)=$P(^(0),U,4)+1
L -^FSCD("STU MSG",0)
S DIK="^FSCD(""STU MSG"",",DA=NUM D IX1^DIK
S ^FSCD("STU MSG",NUM,1,0)="^^"_MSGNUM_U_MSGNUM_U_DT_U
M ^FSCD("STU MSG",NUM,1)=MSG
;
D CHECK(PACKAGE,SITE,NUM)
Q
;
CHECK(PACKAGE,SITE,MSGNUM) ;
N PACKGRP,SITETYPE,USER
S PACKGRP=+$P(^FSC("PACK",PACKAGE,0),U,2)
S SITETYPE=+$P(^FSC("SITE",SITE,0),U,13)
; go thru users that have alerts setup, update criteria if needed, alert
S USER=0 F S USER=$O(^FSC("SPEC","AX",USER)) Q:USER'>0 D
.I $D(^FSC("SPEC","AU",USER)) D
..I '$D(^XTMP("FSC STU",USER)) D BUILD(USER)
..D ALERT(USER,MSGNUM,PACKAGE,PACKGRP,SITE,SITETYPE)
.E D
..D BUILD(USER)
..I $D(^FSC("SPEC","AU",USER)) D ALERT(USER,MSGNUM,PACKAGE,PACKGRP,SITE,SITETYPE)
Q
;
BUILD(USER) ;
N MATCH,NUM,NUM1,VALUE,VALUE1
I '$D(^XTMP("FSC STU",0)) K ^XTMP("FSC STU") S ^XTMP("FSC STU",0)=$$FMADD^XLFDT(DT,7)_U_DT
K ^XTMP("FSC STU",USER)
I '$$VALID(USER) D
.; if invalid criteria cleanup files
.K ^FSC("SPEC","AX",USER)
.K ^FSC("SPEC","AU",USER)
E D
.; if criteria is valid, update criteria
.S MATCH=+$G(^FSC("SPEC",USER,40))
.I 'MATCH D
..S NUM=0 F S NUM=$O(^FSC("SPEC",USER,41,NUM)) Q:NUM<1 S VALUE=+$G(^(NUM,0)) I VALUE S ^XTMP("FSC STU",USER,"P",VALUE)=""
..S NUM=0 F S NUM=$O(^FSC("SPEC",USER,42,NUM)) Q:NUM<1 S VALUE=+$G(^(NUM,0)) I VALUE S ^XTMP("FSC STU",USER,"PG",VALUE)=""
..S NUM=0 F S NUM=$O(^FSC("SPEC",USER,43,NUM)) Q:NUM<1 S VALUE=+$G(^(NUM,0)) I VALUE S ^XTMP("FSC STU",USER,"S",VALUE)=""
..S NUM=0 F S NUM=$O(^FSC("SPEC",USER,44,NUM)) Q:NUM<1 S VALUE=+$G(^(NUM,0)) I VALUE S ^XTMP("FSC STU",USER,"ST",VALUE)=""
.E D
..S NUM=0 F S NUM=$O(^FSC("SPEC",USER,41,NUM)) Q:NUM<1 S VALUE=+$G(^(NUM,0)) I VALUE D
...S NUM1=0 F S NUM1=$O(^FSC("SPEC",USER,43,NUM1)) Q:NUM1<1 S VALUE1=+$G(^(NUM1,0)) I VALUE1 S ^XTMP("FSC STU",USER,"PS",VALUE,VALUE1)=""
...S NUM1=0 F S NUM1=$O(^FSC("SPEC",USER,44,NUM1)) Q:NUM1<1 S VALUE1=+$G(^(NUM1,0)) I VALUE1 S ^XTMP("FSC STU",USER,"PST",VALUE,VALUE1)=""
..S NUM=0 F S NUM=$O(^FSC("SPEC",USER,42,NUM)) Q:NUM<1 S VALUE=+$G(^(NUM,0)) I VALUE D
...S NUM1=0 F S NUM1=$O(^FSC("SPEC",USER,43,NUM1)) Q:NUM1<1 S VALUE1=+$G(^(NUM1,0)) I VALUE1 S ^XTMP("FSC STU",USER,"PGS",VALUE,VALUE1)=""
...S NUM1=0 F S NUM1=$O(^FSC("SPEC",USER,44,NUM1)) Q:NUM1<1 S VALUE1=+$G(^(NUM1,0)) I VALUE1 S ^XTMP("FSC STU",USER,"PGST",VALUE,VALUE1)=""
.S ^FSC("SPEC","AU",USER)=""
Q
;
ALERT(USER,MSGNUM,PACKAGE,PACKGRP,SITE,SITETYPE) ;
N DA,DIK,NUM,OK,XQA,XQADATA,XQAID,XQAMSG,XQAROU K XQA
; if criteria matches site tracking info, add to alert file, alert if new
S OK=0 D
.I $D(^XTMP("FSC STU",USER,"P",PACKAGE)) S OK=1 Q
.I $D(^XTMP("FSC STU",USER,"PG",PACKGRP)) S OK=1 Q
.I $D(^XTMP("FSC STU",USER,"S",SITE)) S OK=1 Q
.I $D(^XTMP("FSC STU",USER,"ST",SITETYPE)) S OK=1 Q
.I $D(^XTMP("FSC STU",USER,"PS",PACKAGE,SITE)) S OK=1 Q
.I $D(^XTMP("FSC STU",USER,"PST",PACKAGE,SITETYPE)) S OK=1 Q
.I $D(^XTMP("FSC STU",USER,"PGS",PACKGRP,SITE)) S OK=1 Q
.I $D(^XTMP("FSC STU",USER,"PGST",PACKGRP,SITETYPE)) S OK=1 Q
I 'OK Q
I $O(^FSCD("STU ALERT","B",USER,0)) S OK=0
;
S NUM=1+$P(^FSCD("STU ALERT",0),U,3)
L +^FSCD("STU ALERT",0):30 I '$T Q ; *** skip
F Q:'$D(^FSCD("STU ALERT",NUM,0)) S NUM=NUM+1
S ^FSCD("STU ALERT",NUM,0)=USER_U_MSGNUM
S $P(^FSCD("STU ALERT",0),U,3)=NUM,$P(^(0),U,4)=$P(^(0),U,4)+1
L -^FSCD("STU ALERT",0)
S DIK="^FSCD(""STU ALERT"",",DA=NUM D IX1^DIK
;
I OK D
.S XQA(USER)="",XQADATA="",XQAMSG="Site Tracking Update",XQAROU="ALERT^FSCSTUR",XQAID="FSC/ST"
.D SETUP^XQALERT
Q
;
VALID(USER) ; $$(user) -> 0 or 1 if set up for site tracking alerts
I $O(^FSC("SPEC",USER,41,0)) Q 1
I $O(^FSC("SPEC",USER,42,0)) Q 1
I $O(^FSC("SPEC",USER,43,0)) Q 1
I $O(^FSC("SPEC",USER,44,0)) Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCSTU 4899 printed Dec 13, 2024@02:20:10 Page 2
FSCSTU ;SLC/STAFF-NOIS Site Tracking Update ;1/17/98 16:51
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
UPDATE(MSG,PACKAGE,SITE,DATE) ; from A5CSTS
+1 NEW VAR,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
KILL ZTSAVE
+2 SET ZTIO=$$RESOURCE^FSCTASK($$DOW^XLFDT(DT,1)+1)
SET ZTRTN="SETUP^FSCSTU"
SET ZTDTH=$HOROLOG
SET ZTDESC="NOIS Site Tracking Updates"
+3 FOR VAR="MSG(","PACKAGE","SITE","DATE"
SET ZTSAVE(VAR)=""
+4 DO ^%ZTLOAD
+5 QUIT
+6 ;
SETUP ; dequeued
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 if '$GET(DATE)
QUIT
if '$LENGTH($GET(PACKAGE))
QUIT
if '$LENGTH($GET(SITE))
QUIT
if '$ORDER(MSG(0))
QUIT
+3 NEW DA,DIK,MSGNUM,NUM,PACKNUM,SITENUM
+4 ; convert date, official package name, and domain for NOIS
+5 SET DATE=DATE\1
+6 SET PACKNUM=+$ORDER(^DIC(9.4,"B",PACKAGE,0))
SET PACKAGE=+$ORDER(^FSC("PACK","AC",PACKNUM,0))
+7 SET SITENUM=+$ORDER(^DIC(4.2,"B",SITE,0))
SET SITE=+$ORDER(^FSC("SITE","AE",SITENUM,0))
+8 SET MSGNUM=+$ORDER(MSG(""),-1)
+9 if 'DATE
QUIT
if 'PACKAGE
QUIT
if 'SITE
QUIT
if 'MSGNUM
QUIT
+10 ;
+11 ; setup msg
+12 SET NUM=1+$PIECE(^FSCD("STU MSG",0),U,3)
+13 ; *** skip
LOCK +^FSCD("STU MSG",0):30
IF '$TEST
QUIT
+14 FOR
if '$DATA(^FSCD("STU MSG",NUM,0))
QUIT
SET NUM=NUM+1
+15 SET ^FSCD("STU MSG",NUM,0)=DATE_U_PACKAGE_U_SITE
+16 SET $PIECE(^FSCD("STU MSG",0),U,3)=NUM
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+17 LOCK -^FSCD("STU MSG",0)
+18 SET DIK="^FSCD(""STU MSG"","
SET DA=NUM
DO IX1^DIK
+19 SET ^FSCD("STU MSG",NUM,1,0)="^^"_MSGNUM_U_MSGNUM_U_DT_U
+20 MERGE ^FSCD("STU MSG",NUM,1)=MSG
+21 ;
+22 DO CHECK(PACKAGE,SITE,NUM)
+23 QUIT
+24 ;
CHECK(PACKAGE,SITE,MSGNUM) ;
+1 NEW PACKGRP,SITETYPE,USER
+2 SET PACKGRP=+$PIECE(^FSC("PACK",PACKAGE,0),U,2)
+3 SET SITETYPE=+$PIECE(^FSC("SITE",SITE,0),U,13)
+4 ; go thru users that have alerts setup, update criteria if needed, alert
+5 SET USER=0
FOR
SET USER=$ORDER(^FSC("SPEC","AX",USER))
if USER'>0
QUIT
Begin DoDot:1
+6 IF $DATA(^FSC("SPEC","AU",USER))
Begin DoDot:2
+7 IF '$DATA(^XTMP("FSC STU",USER))
DO BUILD(USER)
+8 DO ALERT(USER,MSGNUM,PACKAGE,PACKGRP,SITE,SITETYPE)
End DoDot:2
+9 IF '$TEST
Begin DoDot:2
+10 DO BUILD(USER)
+11 IF $DATA(^FSC("SPEC","AU",USER))
DO ALERT(USER,MSGNUM,PACKAGE,PACKGRP,SITE,SITETYPE)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
BUILD(USER) ;
+1 NEW MATCH,NUM,NUM1,VALUE,VALUE1
+2 IF '$DATA(^XTMP("FSC STU",0))
KILL ^XTMP("FSC STU")
SET ^XTMP("FSC STU",0)=$$FMADD^XLFDT(DT,7)_U_DT
+3 KILL ^XTMP("FSC STU",USER)
+4 IF '$$VALID(USER)
Begin DoDot:1
+5 ; if invalid criteria cleanup files
+6 KILL ^FSC("SPEC","AX",USER)
+7 KILL ^FSC("SPEC","AU",USER)
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 ; if criteria is valid, update criteria
+10 SET MATCH=+$GET(^FSC("SPEC",USER,40))
+11 IF 'MATCH
Begin DoDot:2
+12 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("SPEC",USER,41,NUM))
if NUM<1
QUIT
SET VALUE=+$GET(^(NUM,0))
IF VALUE
SET ^XTMP("FSC STU",USER,"P",VALUE)=""
+13 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("SPEC",USER,42,NUM))
if NUM<1
QUIT
SET VALUE=+$GET(^(NUM,0))
IF VALUE
SET ^XTMP("FSC STU",USER,"PG",VALUE)=""
+14 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("SPEC",USER,43,NUM))
if NUM<1
QUIT
SET VALUE=+$GET(^(NUM,0))
IF VALUE
SET ^XTMP("FSC STU",USER,"S",VALUE)=""
+15 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("SPEC",USER,44,NUM))
if NUM<1
QUIT
SET VALUE=+$GET(^(NUM,0))
IF VALUE
SET ^XTMP("FSC STU",USER,"ST",VALUE)=""
End DoDot:2
+16 IF '$TEST
Begin DoDot:2
+17 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("SPEC",USER,41,NUM))
if NUM<1
QUIT
SET VALUE=+$GET(^(NUM,0))
IF VALUE
Begin DoDot:3
+18 SET NUM1=0
FOR
SET NUM1=$ORDER(^FSC("SPEC",USER,43,NUM1))
if NUM1<1
QUIT
SET VALUE1=+$GET(^(NUM1,0))
IF VALUE1
SET ^XTMP("FSC STU",USER,"PS",VALUE,VALUE1)=""
+19 SET NUM1=0
FOR
SET NUM1=$ORDER(^FSC("SPEC",USER,44,NUM1))
if NUM1<1
QUIT
SET VALUE1=+$GET(^(NUM1,0))
IF VALUE1
SET ^XTMP("FSC STU",USER,"PST",VALUE,VALUE1)=""
End DoDot:3
+20 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("SPEC",USER,42,NUM))
if NUM<1
QUIT
SET VALUE=+$GET(^(NUM,0))
IF VALUE
Begin DoDot:3
+21 SET NUM1=0
FOR
SET NUM1=$ORDER(^FSC("SPEC",USER,43,NUM1))
if NUM1<1
QUIT
SET VALUE1=+$GET(^(NUM1,0))
IF VALUE1
SET ^XTMP("FSC STU",USER,"PGS",VALUE,VALUE1)=""
+22 SET NUM1=0
FOR
SET NUM1=$ORDER(^FSC("SPEC",USER,44,NUM1))
if NUM1<1
QUIT
SET VALUE1=+$GET(^(NUM1,0))
IF VALUE1
SET ^XTMP("FSC STU",USER,"PGST",VALUE,VALUE1)=""
End DoDot:3
End DoDot:2
+23 SET ^FSC("SPEC","AU",USER)=""
End DoDot:1
+24 QUIT
+25 ;
ALERT(USER,MSGNUM,PACKAGE,PACKGRP,SITE,SITETYPE) ;
+1 NEW DA,DIK,NUM,OK,XQA,XQADATA,XQAID,XQAMSG,XQAROU
KILL XQA
+2 ; if criteria matches site tracking info, add to alert file, alert if new
+3 SET OK=0
Begin DoDot:1
+4 IF $DATA(^XTMP("FSC STU",USER,"P",PACKAGE))
SET OK=1
QUIT
+5 IF $DATA(^XTMP("FSC STU",USER,"PG",PACKGRP))
SET OK=1
QUIT
+6 IF $DATA(^XTMP("FSC STU",USER,"S",SITE))
SET OK=1
QUIT
+7 IF $DATA(^XTMP("FSC STU",USER,"ST",SITETYPE))
SET OK=1
QUIT
+8 IF $DATA(^XTMP("FSC STU",USER,"PS",PACKAGE,SITE))
SET OK=1
QUIT
+9 IF $DATA(^XTMP("FSC STU",USER,"PST",PACKAGE,SITETYPE))
SET OK=1
QUIT
+10 IF $DATA(^XTMP("FSC STU",USER,"PGS",PACKGRP,SITE))
SET OK=1
QUIT
+11 IF $DATA(^XTMP("FSC STU",USER,"PGST",PACKGRP,SITETYPE))
SET OK=1
QUIT
End DoDot:1
+12 IF 'OK
QUIT
+13 IF $ORDER(^FSCD("STU ALERT","B",USER,0))
SET OK=0
+14 ;
+15 SET NUM=1+$PIECE(^FSCD("STU ALERT",0),U,3)
+16 ; *** skip
LOCK +^FSCD("STU ALERT",0):30
IF '$TEST
QUIT
+17 FOR
if '$DATA(^FSCD("STU ALERT",NUM,0))
QUIT
SET NUM=NUM+1
+18 SET ^FSCD("STU ALERT",NUM,0)=USER_U_MSGNUM
+19 SET $PIECE(^FSCD("STU ALERT",0),U,3)=NUM
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+20 LOCK -^FSCD("STU ALERT",0)
+21 SET DIK="^FSCD(""STU ALERT"","
SET DA=NUM
DO IX1^DIK
+22 ;
+23 IF OK
Begin DoDot:1
+24 SET XQA(USER)=""
SET XQADATA=""
SET XQAMSG="Site Tracking Update"
SET XQAROU="ALERT^FSCSTUR"
SET XQAID="FSC/ST"
+25 DO SETUP^XQALERT
End DoDot:1
+26 QUIT
+27 ;
VALID(USER) ; $$(user) -> 0 or 1 if set up for site tracking alerts
+1 IF $ORDER(^FSC("SPEC",USER,41,0))
QUIT 1
+2 IF $ORDER(^FSC("SPEC",USER,42,0))
QUIT 1
+3 IF $ORDER(^FSC("SPEC",USER,43,0))
QUIT 1
+4 IF $ORDER(^FSC("SPEC",USER,44,0))
QUIT 1
+5 QUIT 0
