- 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 Feb 19, 2025@00:06:10 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
