source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCTASKA.m@ 1742

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1FSCTASKA ;SLC/STAFF-NOIS Task Age ;5/4/98 16:54
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4AGE ; from option
5 ; queued to run after midnite
6 I $D(ZTQUEUED) S ZTREQ="@"
7 N CALL,DAYSC,DAYSX,END,OK,START,TODAY,TOMORROW,UPDATE
8 S TODAY=DT,TOMORROW=$$FMADD^XLFDT(TODAY,1)
9 I '$D(^XTMP("FSC UPDATE",0)) K ^XTMP("FSC UPDATE") S ^XTMP("FSC UPDATE",0)=$$FMADD^XLFDT(TODAY,7)_U_TODAY
10 S START=$$NOW^XLFDT,^XTMP("FSC UPDATE",-START)=$$FMTE^XLFDT(START)
11 S UPDATE=$S($E(START,9,10)>11:TOMORROW,1:TODAY)
12 S DAYSC=$P(^FSC("PARAM",1,0),U,6),DAYSX=$P(^(0),U,5)
13 S CALL=0 F S CALL=$O(^FSCD("CALL",CALL)) Q:CALL<1 D
14 .D DEL(CALL,DAYSX,DAYSC,.OK) I 'OK Q
15 .D UPDATE(CALL,UPDATE)
16 .D AFFIL^FSCAFFIL(CALL)
17 S ^XTMP("FSCRPC",0)=$$FMADD^XLFDT(TODAY,7)_U_TODAY
18 K ^XTMP("FSC LIST DEF") S ^XTMP("FSC LIST DEF",0)=$$FMADD^XLFDT(TODAY,7)_U_TODAY
19 S ^XTMP("FSC UPDATE",-START,1)=$$NOW^XLFDT
20 D UPDATE^FSCLP()
21 S ^XTMP("FSC UPDATE",-START,2)=$$NOW^XLFDT
22 D NOTIFY^FSCTASKN
23 D MSG
24 D CHKALERT^FSCTASKN
25 D DELIVERY^FSCTASKN(UPDATE)
26 D MRE^FSCMRK,MRA^FSCMRK,MRU^FSCMRK
27 D ALL^FSCXPOST
28 S END=$$NOW^XLFDT,$P(^XTMP("FSC UPDATE",-START),U,2,3)=$$FMTE^XLFDT(END)_U_$$FMDIFF^XLFDT(END,START,3)
29 Q
30 ;
31DEL(CALL,CANCEL,CLOSE,OK) ;
32 S OK=1
33 I CANCEL,$P(^FSCD("CALL",CALL,0),U,2)=99,$P(^(0),U,19)>CANCEL D DELETE^FSCUCD(CALL) S OK=0 Q
34 ; ***I CLOSE,$P(^FSCD("CALL",CALL,0),U,2)=2,$P(^(0),U,19)>CLOSE,$$MOD($P(^(0),U,8)) D DELETE^FSCUCD(CALL) S OK=0 Q
35 Q
36 ;
37MOD(MOD) ; $$(module) -> "" or 1 (when old and inactive version)
38 N INACTIVE,OLD,ZERO
39 S ZERO=$G(^FSC("MOD",+MOD,0)),INACTIVE=$P(ZERO,U,2),OLD=$S($P(ZERO,U,3)=3:1,1:"")
40 I INACTIVE,OLD Q 1
41 Q ""
42 ;
43UPDATE(CALL,DATE) ; from FSCTASKU
44 N DA,DAYS,DIE,DISC,DR,LASTSTAT,LASTEDIT,LTYPE,MOD,ODISC,OLD,OLTYPE,OPACK,OPACKG,OSISC,OSPISC,OSYS,OVISN,PACK,PACKG,PRIMARY,SISC,SITE,SPEC,SPISC,SYS,VISN
45 I '$G(DATE) S DATE=DT
46 S DA=CALL,DIE="^FSCD(""CALL"",",DR=""
47 S SITE=+$P(^FSCD("CALL",CALL,0),U,5),MOD=+$P(^(0),U,8),SPEC=+$P(^(0),U,9),OSISC=+$P(^(0),U,16),ODISC=+$P(^(0),U,20)
48 S LASTSTAT=$P(^FSCD("CALL",CALL,120),U,2)\1,LASTEDIT=$P(^(120),U,4)\1,OLD=$P(^(120),U)\1,OLTYPE=+$P(^(120),U,12),OPACK=+$P(^(120),U,9),OPACKG=+$P(^(120),U,13),OSPISC=+$P(^(120),U,10),OSYS=+$P(^(120),U,19),OVISN=+$P(^(120),U,14)
49 S PRIMARY=$P(^FSCD("CALL",CALL,120),U,24) I 'PRIMARY S DR=DR_"101///`"_CALL_";102///@;"
50 I LASTSTAT S DAYS=$$FMDIFF^XLFDT(DATE,LASTSTAT,1),DR=DR_"4.4///"_DAYS_";"
51 I LASTEDIT S DAYS=$$FMDIFF^XLFDT(DATE,LASTEDIT,1),DR=DR_"4.3///"_DAYS_";"
52 I OLD S DAYS=$$FMDIFF^XLFDT(DATE,OLD,1),DR=DR_"4.2///"_DAYS_";"
53 I 'SITE S DR=DR_"2.3///@;2.7///@;2.8///@;"
54 I SITE S SISC=+$P($G(^FSC("SITE",SITE,0)),U,11),LTYPE=+$P($G(^(0)),U,13),VISN=+$P($G(^(0)),U,12),SYS=+$P($G(^(0)),U,16) D
55 .I SISC,SISC'=OSISC S DR=DR_"2.3///`"_SISC_";"
56 .I LTYPE,LTYPE'=OLTYPE S DR=DR_"2.7///`"_LTYPE_";"
57 .I VISN,VISN'=OVISN S DR=DR_"2.8///`"_VISN_";"
58 .I 'VISN,OVISN S DR=DR_"2.8///@;"
59 .I SYS,SYS'=OSYS S DR=DR_"2.9///`"_SYS_";"
60 .I 'SYS,OSYS S DR=DR_"2.9///@;"
61 I 'SPEC S DR=DR_"2.55///@;"
62 I SPEC S SPISC=+$P($G(^FSC("SPEC",SPEC,0)),U,16) I SPISC,SPISC'=OSPISC S DR=DR_"2.55///`"_SPISC_";"
63 I 'MOD S DR=DR_"2.4///@;3.1///@;3.3///@;"
64 I MOD S DISC=+$P($G(^FSC("MOD",MOD,0)),U,5),PACK=+$P($G(^(0)),U,8) D
65 .I DISC,DISC'=ODISC S DR=DR_"2.4///`"_DISC_";"
66 .I 'DISC,ODISC S DR=DR_"2.4///@;"
67 .I PACK D
68 ..I PACK'=OPACK S DR=DR_"3.1///`"_PACK_";"
69 ..S PACKG=+$P($G(^FSC("PACK",PACK,0)),U,2)
70 ..I 'PACKG S DR=DR_"3.3///@;" Q
71 ..I PACKG'=OPACKG S DR=DR_"3.3///`"_PACKG_";"
72 I '$L(DR) Q
73 L +^FSCD("CALL",CALL):20 I '$T Q
74 D ^DIE
75 L -^FSCD("CALL",CALL)
76 Q
77 ;
78MSG ;
79 I $P(^FSC("PARAM",1,0),U,7),$P(^(0),U,7)>DT Q
80 N DA,DIE,DR
81 S DIE="^FSC(""PARAM"",",DA=1,DR="100///@;101///@" D ^DIE
82 Q
Note: See TracBrowser for help on using the repository browser.