source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCSTU.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1FSCSTU ;SLC/STAFF-NOIS Site Tracking Update ;1/17/98 16:51
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4UPDATE(MSG,PACKAGE,SITE,DATE) ; from A5CSTS
5 N VAR,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE K ZTSAVE
6 S ZTIO=$$RESOURCE^FSCTASK($$DOW^XLFDT(DT,1)+1),ZTRTN="SETUP^FSCSTU",ZTDTH=$H,ZTDESC="NOIS Site Tracking Updates"
7 F VAR="MSG(","PACKAGE","SITE","DATE" S ZTSAVE(VAR)=""
8 D ^%ZTLOAD
9 Q
10 ;
11SETUP ; dequeued
12 I $D(ZTQUEUED) S ZTREQ="@"
13 Q:'$G(DATE) Q:'$L($G(PACKAGE)) Q:'$L($G(SITE)) Q:'$O(MSG(0))
14 N DA,DIK,MSGNUM,NUM,PACKNUM,SITENUM
15 ; convert date, official package name, and domain for NOIS
16 S DATE=DATE\1
17 S PACKNUM=+$O(^DIC(9.4,"B",PACKAGE,0)),PACKAGE=+$O(^FSC("PACK","AC",PACKNUM,0))
18 S SITENUM=+$O(^DIC(4.2,"B",SITE,0)),SITE=+$O(^FSC("SITE","AE",SITENUM,0))
19 S MSGNUM=+$O(MSG(""),-1)
20 Q:'DATE Q:'PACKAGE Q:'SITE Q:'MSGNUM
21 ;
22 ; setup msg
23 S NUM=1+$P(^FSCD("STU MSG",0),U,3)
24 L +^FSCD("STU MSG",0):30 I '$T Q ; *** skip
25 F Q:'$D(^FSCD("STU MSG",NUM,0)) S NUM=NUM+1
26 S ^FSCD("STU MSG",NUM,0)=DATE_U_PACKAGE_U_SITE
27 S $P(^FSCD("STU MSG",0),U,3)=NUM,$P(^(0),U,4)=$P(^(0),U,4)+1
28 L -^FSCD("STU MSG",0)
29 S DIK="^FSCD(""STU MSG"",",DA=NUM D IX1^DIK
30 S ^FSCD("STU MSG",NUM,1,0)="^^"_MSGNUM_U_MSGNUM_U_DT_U
31 M ^FSCD("STU MSG",NUM,1)=MSG
32 ;
33 D CHECK(PACKAGE,SITE,NUM)
34 Q
35 ;
36CHECK(PACKAGE,SITE,MSGNUM) ;
37 N PACKGRP,SITETYPE,USER
38 S PACKGRP=+$P(^FSC("PACK",PACKAGE,0),U,2)
39 S SITETYPE=+$P(^FSC("SITE",SITE,0),U,13)
40 ; go thru users that have alerts setup, update criteria if needed, alert
41 S USER=0 F S USER=$O(^FSC("SPEC","AX",USER)) Q:USER'>0 D
42 .I $D(^FSC("SPEC","AU",USER)) D
43 ..I '$D(^XTMP("FSC STU",USER)) D BUILD(USER)
44 ..D ALERT(USER,MSGNUM,PACKAGE,PACKGRP,SITE,SITETYPE)
45 .E D
46 ..D BUILD(USER)
47 ..I $D(^FSC("SPEC","AU",USER)) D ALERT(USER,MSGNUM,PACKAGE,PACKGRP,SITE,SITETYPE)
48 Q
49 ;
50BUILD(USER) ;
51 N MATCH,NUM,NUM1,VALUE,VALUE1
52 I '$D(^XTMP("FSC STU",0)) K ^XTMP("FSC STU") S ^XTMP("FSC STU",0)=$$FMADD^XLFDT(DT,7)_U_DT
53 K ^XTMP("FSC STU",USER)
54 I '$$VALID(USER) D
55 .; if invalid criteria cleanup files
56 .K ^FSC("SPEC","AX",USER)
57 .K ^FSC("SPEC","AU",USER)
58 E D
59 .; if criteria is valid, update criteria
60 .S MATCH=+$G(^FSC("SPEC",USER,40))
61 .I 'MATCH D
62 ..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)=""
63 ..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)=""
64 ..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)=""
65 ..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)=""
66 .E D
67 ..S NUM=0 F S NUM=$O(^FSC("SPEC",USER,41,NUM)) Q:NUM<1 S VALUE=+$G(^(NUM,0)) I VALUE D
68 ...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)=""
69 ...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)=""
70 ..S NUM=0 F S NUM=$O(^FSC("SPEC",USER,42,NUM)) Q:NUM<1 S VALUE=+$G(^(NUM,0)) I VALUE D
71 ...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)=""
72 ...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)=""
73 .S ^FSC("SPEC","AU",USER)=""
74 Q
75 ;
76ALERT(USER,MSGNUM,PACKAGE,PACKGRP,SITE,SITETYPE) ;
77 N DA,DIK,NUM,OK,XQA,XQADATA,XQAID,XQAMSG,XQAROU K XQA
78 ; if criteria matches site tracking info, add to alert file, alert if new
79 S OK=0 D
80 .I $D(^XTMP("FSC STU",USER,"P",PACKAGE)) S OK=1 Q
81 .I $D(^XTMP("FSC STU",USER,"PG",PACKGRP)) S OK=1 Q
82 .I $D(^XTMP("FSC STU",USER,"S",SITE)) S OK=1 Q
83 .I $D(^XTMP("FSC STU",USER,"ST",SITETYPE)) S OK=1 Q
84 .I $D(^XTMP("FSC STU",USER,"PS",PACKAGE,SITE)) S OK=1 Q
85 .I $D(^XTMP("FSC STU",USER,"PST",PACKAGE,SITETYPE)) S OK=1 Q
86 .I $D(^XTMP("FSC STU",USER,"PGS",PACKGRP,SITE)) S OK=1 Q
87 .I $D(^XTMP("FSC STU",USER,"PGST",PACKGRP,SITETYPE)) S OK=1 Q
88 I 'OK Q
89 I $O(^FSCD("STU ALERT","B",USER,0)) S OK=0
90 ;
91 S NUM=1+$P(^FSCD("STU ALERT",0),U,3)
92 L +^FSCD("STU ALERT",0):30 I '$T Q ; *** skip
93 F Q:'$D(^FSCD("STU ALERT",NUM,0)) S NUM=NUM+1
94 S ^FSCD("STU ALERT",NUM,0)=USER_U_MSGNUM
95 S $P(^FSCD("STU ALERT",0),U,3)=NUM,$P(^(0),U,4)=$P(^(0),U,4)+1
96 L -^FSCD("STU ALERT",0)
97 S DIK="^FSCD(""STU ALERT"",",DA=NUM D IX1^DIK
98 ;
99 I OK D
100 .S XQA(USER)="",XQADATA="",XQAMSG="Site Tracking Update",XQAROU="ALERT^FSCSTUR",XQAID="FSC/ST"
101 .D SETUP^XQALERT
102 Q
103 ;
104VALID(USER) ; $$(user) -> 0 or 1 if set up for site tracking alerts
105 I $O(^FSC("SPEC",USER,41,0)) Q 1
106 I $O(^FSC("SPEC",USER,42,0)) Q 1
107 I $O(^FSC("SPEC",USER,43,0)) Q 1
108 I $O(^FSC("SPEC",USER,44,0)) Q 1
109 Q 0
Note: See TracBrowser for help on using the repository browser.