FSCTASKA ;SLC/STAFF-NOIS Task Age ;5/4/98 16:54
;;1.1;NOIS;;Sep 06, 1998
;
AGE ; from option
; queued to run after midnite
I $D(ZTQUEUED) S ZTREQ="@"
N CALL,DAYSC,DAYSX,END,OK,START,TODAY,TOMORROW,UPDATE
S TODAY=DT,TOMORROW=$$FMADD^XLFDT(TODAY,1)
I '$D(^XTMP("FSC UPDATE",0)) K ^XTMP("FSC UPDATE") S ^XTMP("FSC UPDATE",0)=$$FMADD^XLFDT(TODAY,7)_U_TODAY
S START=$$NOW^XLFDT,^XTMP("FSC UPDATE",-START)=$$FMTE^XLFDT(START)
S UPDATE=$S($E(START,9,10)>11:TOMORROW,1:TODAY)
S DAYSC=$P(^FSC("PARAM",1,0),U,6),DAYSX=$P(^(0),U,5)
S CALL=0 F S CALL=$O(^FSCD("CALL",CALL)) Q:CALL<1 D
.D DEL(CALL,DAYSX,DAYSC,.OK) I 'OK Q
.D UPDATE(CALL,UPDATE)
.D AFFIL^FSCAFFIL(CALL)
S ^XTMP("FSCRPC",0)=$$FMADD^XLFDT(TODAY,7)_U_TODAY
K ^XTMP("FSC LIST DEF") S ^XTMP("FSC LIST DEF",0)=$$FMADD^XLFDT(TODAY,7)_U_TODAY
S ^XTMP("FSC UPDATE",-START,1)=$$NOW^XLFDT
D UPDATE^FSCLP()
S ^XTMP("FSC UPDATE",-START,2)=$$NOW^XLFDT
D NOTIFY^FSCTASKN
D MSG
D CHKALERT^FSCTASKN
D DELIVERY^FSCTASKN(UPDATE)
D MRE^FSCMRK,MRA^FSCMRK,MRU^FSCMRK
D ALL^FSCXPOST
S END=$$NOW^XLFDT,$P(^XTMP("FSC UPDATE",-START),U,2,3)=$$FMTE^XLFDT(END)_U_$$FMDIFF^XLFDT(END,START,3)
Q
;
DEL(CALL,CANCEL,CLOSE,OK) ;
S OK=1
I CANCEL,$P(^FSCD("CALL",CALL,0),U,2)=99,$P(^(0),U,19)>CANCEL D DELETE^FSCUCD(CALL) S OK=0 Q
; ***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
Q
;
MOD(MOD) ; $$(module) -> "" or 1 (when old and inactive version)
N INACTIVE,OLD,ZERO
S ZERO=$G(^FSC("MOD",+MOD,0)),INACTIVE=$P(ZERO,U,2),OLD=$S($P(ZERO,U,3)=3:1,1:"")
I INACTIVE,OLD Q 1
Q ""
;
UPDATE(CALL,DATE) ; from FSCTASKU
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
I '$G(DATE) S DATE=DT
S DA=CALL,DIE="^FSCD(""CALL"",",DR=""
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)
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)
S PRIMARY=$P(^FSCD("CALL",CALL,120),U,24) I 'PRIMARY S DR=DR_"101///`"_CALL_";102///@;"
I LASTSTAT S DAYS=$$FMDIFF^XLFDT(DATE,LASTSTAT,1),DR=DR_"4.4///"_DAYS_";"
I LASTEDIT S DAYS=$$FMDIFF^XLFDT(DATE,LASTEDIT,1),DR=DR_"4.3///"_DAYS_";"
I OLD S DAYS=$$FMDIFF^XLFDT(DATE,OLD,1),DR=DR_"4.2///"_DAYS_";"
I 'SITE S DR=DR_"2.3///@;2.7///@;2.8///@;"
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
.I SISC,SISC'=OSISC S DR=DR_"2.3///`"_SISC_";"
.I LTYPE,LTYPE'=OLTYPE S DR=DR_"2.7///`"_LTYPE_";"
.I VISN,VISN'=OVISN S DR=DR_"2.8///`"_VISN_";"
.I 'VISN,OVISN S DR=DR_"2.8///@;"
.I SYS,SYS'=OSYS S DR=DR_"2.9///`"_SYS_";"
.I 'SYS,OSYS S DR=DR_"2.9///@;"
I 'SPEC S DR=DR_"2.55///@;"
I SPEC S SPISC=+$P($G(^FSC("SPEC",SPEC,0)),U,16) I SPISC,SPISC'=OSPISC S DR=DR_"2.55///`"_SPISC_";"
I 'MOD S DR=DR_"2.4///@;3.1///@;3.3///@;"
I MOD S DISC=+$P($G(^FSC("MOD",MOD,0)),U,5),PACK=+$P($G(^(0)),U,8) D
.I DISC,DISC'=ODISC S DR=DR_"2.4///`"_DISC_";"
.I 'DISC,ODISC S DR=DR_"2.4///@;"
.I PACK D
..I PACK'=OPACK S DR=DR_"3.1///`"_PACK_";"
..S PACKG=+$P($G(^FSC("PACK",PACK,0)),U,2)
..I 'PACKG S DR=DR_"3.3///@;" Q
..I PACKG'=OPACKG S DR=DR_"3.3///`"_PACKG_";"
I '$L(DR) Q
L +^FSCD("CALL",CALL):20 I '$T Q
D ^DIE
L -^FSCD("CALL",CALL)
Q
;
MSG ;
I $P(^FSC("PARAM",1,0),U,7),$P(^(0),U,7)>DT Q
N DA,DIE,DR
S DIE="^FSC(""PARAM"",",DA=1,DR="100///@;101///@" D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCTASKA 3728 printed Nov 22, 2024@17:30:17 Page 2
FSCTASKA ;SLC/STAFF-NOIS Task Age ;5/4/98 16:54
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
AGE ; from option
+1 ; queued to run after midnite
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 NEW CALL,DAYSC,DAYSX,END,OK,START,TODAY,TOMORROW,UPDATE
+4 SET TODAY=DT
SET TOMORROW=$$FMADD^XLFDT(TODAY,1)
+5 IF '$DATA(^XTMP("FSC UPDATE",0))
KILL ^XTMP("FSC UPDATE")
SET ^XTMP("FSC UPDATE",0)=$$FMADD^XLFDT(TODAY,7)_U_TODAY
+6 SET START=$$NOW^XLFDT
SET ^XTMP("FSC UPDATE",-START)=$$FMTE^XLFDT(START)
+7 SET UPDATE=$SELECT($EXTRACT(START,9,10)>11:TOMORROW,1:TODAY)
+8 SET DAYSC=$PIECE(^FSC("PARAM",1,0),U,6)
SET DAYSX=$PIECE(^(0),U,5)
+9 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("CALL",CALL))
if CALL<1
QUIT
Begin DoDot:1
+10 DO DEL(CALL,DAYSX,DAYSC,.OK)
IF 'OK
QUIT
+11 DO UPDATE(CALL,UPDATE)
+12 DO AFFIL^FSCAFFIL(CALL)
End DoDot:1
+13 SET ^XTMP("FSCRPC",0)=$$FMADD^XLFDT(TODAY,7)_U_TODAY
+14 KILL ^XTMP("FSC LIST DEF")
SET ^XTMP("FSC LIST DEF",0)=$$FMADD^XLFDT(TODAY,7)_U_TODAY
+15 SET ^XTMP("FSC UPDATE",-START,1)=$$NOW^XLFDT
+16 DO UPDATE^FSCLP()
+17 SET ^XTMP("FSC UPDATE",-START,2)=$$NOW^XLFDT
+18 DO NOTIFY^FSCTASKN
+19 DO MSG
+20 DO CHKALERT^FSCTASKN
+21 DO DELIVERY^FSCTASKN(UPDATE)
+22 DO MRE^FSCMRK
DO MRA^FSCMRK
DO MRU^FSCMRK
+23 DO ALL^FSCXPOST
+24 SET END=$$NOW^XLFDT
SET $PIECE(^XTMP("FSC UPDATE",-START),U,2,3)=$$FMTE^XLFDT(END)_U_$$FMDIFF^XLFDT(END,START,3)
+25 QUIT
+26 ;
DEL(CALL,CANCEL,CLOSE,OK) ;
+1 SET OK=1
+2 IF CANCEL
IF $PIECE(^FSCD("CALL",CALL,0),U,2)=99
IF $PIECE(^(0),U,19)>CANCEL
DO DELETE^FSCUCD(CALL)
SET OK=0
QUIT
+3 ; ***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
+4 QUIT
+5 ;
MOD(MOD) ; $$(module) -> "" or 1 (when old and inactive version)
+1 NEW INACTIVE,OLD,ZERO
+2 SET ZERO=$GET(^FSC("MOD",+MOD,0))
SET INACTIVE=$PIECE(ZERO,U,2)
SET OLD=$SELECT($PIECE(ZERO,U,3)=3:1,1:"")
+3 IF INACTIVE
IF OLD
QUIT 1
+4 QUIT ""
+5 ;
UPDATE(CALL,DATE) ; from FSCTASKU
+1 NEW 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
+2 IF '$GET(DATE)
SET DATE=DT
+3 SET DA=CALL
SET DIE="^FSCD(""CALL"","
SET DR=""
+4 SET SITE=+$PIECE(^FSCD("CALL",CALL,0),U,5)
SET MOD=+$PIECE(^(0),U,8)
SET SPEC=+$PIECE(^(0),U,9)
SET OSISC=+$PIECE(^(0),U,16)
SET ODISC=+$PIECE(^(0),U,20)
+5 SET LASTSTAT=$PIECE(^FSCD("CALL",CALL,120),U,2)\1
SET LASTEDIT=$PIECE(^(120),U,4)\1
SET OLD=$PIECE(^(120),U)\1
SET OLTYPE=+$PIECE(^(120),U,12)
SET OPACK=+$PIECE(^(120),U,9)
SET OPACKG=+$PIECE(^(120),U,13)
SET OSPISC=+$PIECE(^(120),U,10)
SET OSYS=+$PIECE(^(120),U,19)
SET OVISN=+$PIECE(^(120),U,14)
+6 SET PRIMARY=$PIECE(^FSCD("CALL",CALL,120),U,24)
IF 'PRIMARY
SET DR=DR_"101///`"_CALL_";102///@;"
+7 IF LASTSTAT
SET DAYS=$$FMDIFF^XLFDT(DATE,LASTSTAT,1)
SET DR=DR_"4.4///"_DAYS_";"
+8 IF LASTEDIT
SET DAYS=$$FMDIFF^XLFDT(DATE,LASTEDIT,1)
SET DR=DR_"4.3///"_DAYS_";"
+9 IF OLD
SET DAYS=$$FMDIFF^XLFDT(DATE,OLD,1)
SET DR=DR_"4.2///"_DAYS_";"
+10 IF 'SITE
SET DR=DR_"2.3///@;2.7///@;2.8///@;"
+11 IF SITE
SET SISC=+$PIECE($GET(^FSC("SITE",SITE,0)),U,11)
SET LTYPE=+$PIECE($GET(^(0)),U,13)
SET VISN=+$PIECE($GET(^(0)),U,12)
SET SYS=+$PIECE($GET(^(0)),U,16)
Begin DoDot:1
+12 IF SISC
IF SISC'=OSISC
SET DR=DR_"2.3///`"_SISC_";"
+13 IF LTYPE
IF LTYPE'=OLTYPE
SET DR=DR_"2.7///`"_LTYPE_";"
+14 IF VISN
IF VISN'=OVISN
SET DR=DR_"2.8///`"_VISN_";"
+15 IF 'VISN
IF OVISN
SET DR=DR_"2.8///@;"
+16 IF SYS
IF SYS'=OSYS
SET DR=DR_"2.9///`"_SYS_";"
+17 IF 'SYS
IF OSYS
SET DR=DR_"2.9///@;"
End DoDot:1
+18 IF 'SPEC
SET DR=DR_"2.55///@;"
+19 IF SPEC
SET SPISC=+$PIECE($GET(^FSC("SPEC",SPEC,0)),U,16)
IF SPISC
IF SPISC'=OSPISC
SET DR=DR_"2.55///`"_SPISC_";"
+20 IF 'MOD
SET DR=DR_"2.4///@;3.1///@;3.3///@;"
+21 IF MOD
SET DISC=+$PIECE($GET(^FSC("MOD",MOD,0)),U,5)
SET PACK=+$PIECE($GET(^(0)),U,8)
Begin DoDot:1
+22 IF DISC
IF DISC'=ODISC
SET DR=DR_"2.4///`"_DISC_";"
+23 IF 'DISC
IF ODISC
SET DR=DR_"2.4///@;"
+24 IF PACK
Begin DoDot:2
+25 IF PACK'=OPACK
SET DR=DR_"3.1///`"_PACK_";"
+26 SET PACKG=+$PIECE($GET(^FSC("PACK",PACK,0)),U,2)
+27 IF 'PACKG
SET DR=DR_"3.3///@;"
QUIT
+28 IF PACKG'=OPACKG
SET DR=DR_"3.3///`"_PACKG_";"
End DoDot:2
End DoDot:1
+29 IF '$LENGTH(DR)
QUIT
+30 LOCK +^FSCD("CALL",CALL):20
IF '$TEST
QUIT
+31 DO ^DIE
+32 LOCK -^FSCD("CALL",CALL)
+33 QUIT
+34 ;
MSG ;
+1 IF $PIECE(^FSC("PARAM",1,0),U,7)
IF $PIECE(^(0),U,7)>DT
QUIT
+2 NEW DA,DIE,DR
+3 SET DIE="^FSC(""PARAM"","
SET DA=1
SET DR="100///@;101///@"
DO ^DIE
+4 QUIT
