Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUDD61

TIUDD61.m

Go to the documentation of this file.
TIUDD61 ; ISL/JER - M-Type X-refs for file 8926.1 ; 03/23/2007
 ;;1.0;TEXT INTEGRATION UTILITIES;**225**;Jun 20, 1997;Build 13
SET ; Set list of inactivated titles
 ; if no entries logged, initialize log
 N SUBS,TTL
 I '$D(^XTMP("TIUBULL")) D
 . 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"))
 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
 K @TIUTXT,@TIUARR
 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