TIUDD61 ; ISL/JER - M-Type X-refs for file 8926.1 ; 03/23/2007
;;1.0;TEXT INTEGRATION UTILITIES;**225,309**;Jun 20, 1997;Build 5
SET ; Set list of inactivated titles
; if no entries logged, initialize log
N SUBS,TTL
I '$D(^XTMP("TIUBULL",0)) D ; Add ",0" - TIU*1*309
. S ^XTMP("TIUBULL",0)=$$FMADD^XLFDT(DT,1)_U_DT
. S ^XTMP("TIUBULL","T0")=$$NOW^XLFDT
. S ^XTMP("TIUBULL","ACT",0)=0
. S ^XTMP("TIUBULL","INACT",0)=0
; set entry being processed into log
S SUBS=$S(+X:"ACT",1:"INACT")
S TTL=$P($G(^TIU(8926.1,+DA(1),0)),U)
S ^XTMP("TIUBULL",SUBS,0)=^XTMP("TIUBULL",SUBS,0)+1
S ^XTMP("TIUBULL",SUBS,TTL)=DA(1)
I +$O(^TIU(8925.1,"ALOINC",DA(1),0)) D
. N TIUI,TIUJ S (TIUI,TIUJ)=0
. F S TIUI=$O(^TIU(8925.1,"ALOINC",DA(1),TIUI)) Q:+TIUI'>0 D
. . S TIUJ=TIUJ+1
. . S ^XTMP("TIUBULL",SUBS,TTL,"MAP",TIUJ)=TIUI_U_$P($G(^TIU(8925.1,TIUI,0)),U)
Q
BULL ; Send Bulletin to CACs
N TIUSTRT,TIUEND,TIUACNT,TIUICNT,TIUARR,TIUTXT,XMB,XMDUZ,XMTEXT
S TIUTXT=$NA(^TMP("TIUBULL",$J))
K @TIUTXT
S TIUARR=$NA(^XTMP("TIUBULL"))
I $S('$D(@TIUARR@(0)):1,'$D(@TIUARR@("T0")):1,'$D(@TIUARR@("ACT",0)):1,'$D(@TIUARR@("INACT",0)):1,1:0) G BULLX ; TIU*1*309/JCH
S @TIUARR@("T1")=$$NOW^XLFDT
D FORMAT(TIUARR,TIUTXT)
S XMB="TIU ENTERPRISE STANDARD TITLES"
S XMDUZ="TIU ENTERPRISE STANDARD TITLES DEPLOYMENT"
S XMB(1)=$$DATE^TIULS(@TIUARR@("T0"),"MM/DD/YY HR:MIN")
S XMB(2)=$$DATE^TIULS(@TIUARR@("T1"),"MM/DD/YY HR:MIN")
S XMTEXT="^TMP(""TIUBULL"",$J,"
D ^XMB,KILL^XM
BULLX K @TIUTXT,@TIUARR ; TIU*1*309/JCH Added BULLX line tag
Q
FORMAT(TIUARR,TIUTXT) ; Format the body of the bulletin
N LINE,TIUI,TAB,TIUT
S TAB=" ",TIUI=0
S LINE="=========================================================================="
S TIUI=TIUI+1,@TIUTXT@(TIUI,0)=" "
S TIUI=TIUI+1,@TIUTXT@(TIUI,0)=" TITLES ACTIVATED: "_+$G(@TIUARR@("ACT",0))
S TIUI=TIUI+1,@TIUTXT@(TIUI,0)="Enterprise Standard Title"
S TIUI=TIUI+1,@TIUTXT@(TIUI,0)=TAB_"Mapped to Local Title(s)"
S TIUI=TIUI+1,@TIUTXT@(TIUI,0)=LINE
S TIUT=0
F S TIUT=$O(@TIUARR@("ACT",TIUT)) Q:TIUT']"" D
. N TIUJ S TIUJ=0
. S TIUI=TIUI+1,@TIUTXT@(TIUI,0)=TIUT
. F S TIUJ=$O(@TIUARR@("ACT",TIUT,"MAP",TIUJ)) Q:+TIUJ'>0 D
. . S TIUI=TIUI+1,@TIUTXT@(TIUI,0)=TAB_$P(@TIUARR@("ACT",TIUT,"MAP",TIUJ),U,2)
S TIUI=TIUI+1,@TIUTXT@(TIUI,0)=" "
S TIUI=TIUI+1,@TIUTXT@(TIUI,0)=" "
S TIUI=TIUI+1,@TIUTXT@(TIUI,0)=" TITLES INACTIVATED: "_+$G(@TIUARR@("INACT",0))
S TIUI=TIUI+1,@TIUTXT@(TIUI,0)="Enterprise Standard Title"
S TIUI=TIUI+1,@TIUTXT@(TIUI,0)=TAB_"Mapped to Local Title(s)"
S TIUI=TIUI+1,@TIUTXT@(TIUI,0)=LINE
S TIUT=0
F S TIUT=$O(@TIUARR@("INACT",TIUT)) Q:TIUT']"" D
. N TIUJ S TIUJ=0
. S TIUI=TIUI+1,@TIUTXT@(TIUI,0)=TIUT
. F S TIUJ=$O(@TIUARR@("INACT",TIUT,"MAP",TIUJ)) Q:+TIUJ'>0 D
. . S TIUI=TIUI+1,@TIUTXT@(TIUI,0)=TAB_$P(@TIUARR@("INACT",TIUT,"MAP",TIUJ),U,2)
Q
TEST ; Test setting up and sending bulletin w/o having to deploy...
N DA,TIUDA,X S DA=1
F TIUDA=46,117,66,75,299,250,1520 D
. S DA(1)=TIUDA,X=TIUDA#2 D SET
D BULL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUDD61 3088 printed Oct 16, 2024@18:40:18 Page 2
TIUDD61 ; ISL/JER - M-Type X-refs for file 8926.1 ; 03/23/2007
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**225,309**;Jun 20, 1997;Build 5
SET ; Set list of inactivated titles
+1 ; if no entries logged, initialize log
+2 NEW SUBS,TTL
+3 ; Add ",0" - TIU*1*309
IF '$DATA(^XTMP("TIUBULL",0))
Begin DoDot:1
+4 SET ^XTMP("TIUBULL",0)=$$FMADD^XLFDT(DT,1)_U_DT
+5 SET ^XTMP("TIUBULL","T0")=$$NOW^XLFDT
+6 SET ^XTMP("TIUBULL","ACT",0)=0
+7 SET ^XTMP("TIUBULL","INACT",0)=0
End DoDot:1
+8 ; set entry being processed into log
+9 SET SUBS=$SELECT(+X:"ACT",1:"INACT")
+10 SET TTL=$PIECE($GET(^TIU(8926.1,+DA(1),0)),U)
+11 SET ^XTMP("TIUBULL",SUBS,0)=^XTMP("TIUBULL",SUBS,0)+1
+12 SET ^XTMP("TIUBULL",SUBS,TTL)=DA(1)
+13 IF +$ORDER(^TIU(8925.1,"ALOINC",DA(1),0))
Begin DoDot:1
+14 NEW TIUI,TIUJ
SET (TIUI,TIUJ)=0
+15 FOR
SET TIUI=$ORDER(^TIU(8925.1,"ALOINC",DA(1),TIUI))
if +TIUI'>0
QUIT
Begin DoDot:2
+16 SET TIUJ=TIUJ+1
+17 SET ^XTMP("TIUBULL",SUBS,TTL,"MAP",TIUJ)=TIUI_U_$PIECE($GET(^TIU(8925.1,TIUI,0)),U)
End DoDot:2
End DoDot:1
+18 QUIT
BULL ; Send Bulletin to CACs
+1 NEW TIUSTRT,TIUEND,TIUACNT,TIUICNT,TIUARR,TIUTXT,XMB,XMDUZ,XMTEXT
+2 SET TIUTXT=$NAME(^TMP("TIUBULL",$JOB))
+3 KILL @TIUTXT
+4 SET TIUARR=$NAME(^XTMP("TIUBULL"))
+5 ; TIU*1*309/JCH
IF $SELECT('$DATA(@TIUARR@(0)):1,'$DATA(@TIUARR@("T0")):1,'$DATA(@TIUARR@("ACT",0)):1,'$DATA(@TIUARR@("INACT",0)):1,1:0)
GOTO BULLX
+6 SET @TIUARR@("T1")=$$NOW^XLFDT
+7 DO FORMAT(TIUARR,TIUTXT)
+8 SET XMB="TIU ENTERPRISE STANDARD TITLES"
+9 SET XMDUZ="TIU ENTERPRISE STANDARD TITLES DEPLOYMENT"
+10 SET XMB(1)=$$DATE^TIULS(@TIUARR@("T0"),"MM/DD/YY HR:MIN")
+11 SET XMB(2)=$$DATE^TIULS(@TIUARR@("T1"),"MM/DD/YY HR:MIN")
+12 SET XMTEXT="^TMP(""TIUBULL"",$J,"
+13 DO ^XMB
DO KILL^XM
BULLX ; TIU*1*309/JCH Added BULLX line tag
KILL @TIUTXT,@TIUARR
+1 QUIT
FORMAT(TIUARR,TIUTXT) ; Format the body of the bulletin
+1 NEW LINE,TIUI,TAB,TIUT
+2 SET TAB=" "
SET TIUI=0
+3 SET LINE="=========================================================================="
+4 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)=" "
+5 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)=" TITLES ACTIVATED: "_+$GET(@TIUARR@("ACT",0))
+6 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)="Enterprise Standard Title"
+7 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)=TAB_"Mapped to Local Title(s)"
+8 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)=LINE
+9 SET TIUT=0
+10 FOR
SET TIUT=$ORDER(@TIUARR@("ACT",TIUT))
if TIUT']""
QUIT
Begin DoDot:1
+11 NEW TIUJ
SET TIUJ=0
+12 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)=TIUT
+13 FOR
SET TIUJ=$ORDER(@TIUARR@("ACT",TIUT,"MAP",TIUJ))
if +TIUJ'>0
QUIT
Begin DoDot:2
+14 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)=TAB_$PIECE(@TIUARR@("ACT",TIUT,"MAP",TIUJ),U,2)
End DoDot:2
End DoDot:1
+15 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)=" "
+16 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)=" "
+17 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)=" TITLES INACTIVATED: "_+$GET(@TIUARR@("INACT",0))
+18 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)="Enterprise Standard Title"
+19 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)=TAB_"Mapped to Local Title(s)"
+20 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)=LINE
+21 SET TIUT=0
+22 FOR
SET TIUT=$ORDER(@TIUARR@("INACT",TIUT))
if TIUT']""
QUIT
Begin DoDot:1
+23 NEW TIUJ
SET TIUJ=0
+24 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)=TIUT
+25 FOR
SET TIUJ=$ORDER(@TIUARR@("INACT",TIUT,"MAP",TIUJ))
if +TIUJ'>0
QUIT
Begin DoDot:2
+26 SET TIUI=TIUI+1
SET @TIUTXT@(TIUI,0)=TAB_$PIECE(@TIUARR@("INACT",TIUT,"MAP",TIUJ),U,2)
End DoDot:2
End DoDot:1
+27 QUIT
TEST ; Test setting up and sending bulletin w/o having to deploy...
+1 NEW DA,TIUDA,X
SET DA=1
+2 FOR TIUDA=46,117,66,75,299,250,1520
Begin DoDot:1
+3 SET DA(1)=TIUDA
SET X=TIUDA#2
DO SET
End DoDot:1
+4 DO BULL
+5 QUIT
