TIUP242 ; SLC/JER - Installer Routine for TIU*1*242 ;08/14/2008
;;1.0;TEXT INTEGRATION UTILITIES;**242**;Jun 20, 1997;Build 7
Q
;=======================================================
PRE ;Pre-install - If the Exchange File entry already exists delete it.
N ARRAY,IC,IND,LIST,LUVALUE,NUM
D EXARRAY(.ARRAY)
S IC=0
F S IC=$O(ARRAY(IC)) Q:'IC D
. S LUVALUE(1)=ARRAY(IC,1)
. D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
. I '$D(LIST) Q
. S NUM=$P(LIST("DILIST",0),U,1)
. I NUM'=0 D
.. F IND=1:1:NUM D
... N DA,DIK
... S DIK="^PXD(811.8,"
... S DA=LIST("DILIST",2,IND)
... D ^DIK
Q
;
;====================================================
EXARRAY(ARRAY) ;List of exchange entries used by delete and install
N LN
S LN=0
;
S LN=LN+1
S ARRAY(LN,1)="TIU*1*242 20080814"
S ARRAY(LN,2)="08/14/2008@08:20:45"
S ARRAY(LN,3)="O"
;
Q
;
;==========================================
POST ;Post-install.
N ACTION,EXARRAY,IC,IEN,LUVALUE,PXRMINST,TEXT,TIUDC,TIUFPRIV
S (PXRMINST,TIUFPRIV)=1
D EXARRAY(.EXARRAY)
S IC=0
F S IC=$O(EXARRAY(IC)) Q:'IC D
. S LUVALUE(1)=EXARRAY(IC,1),LUVALUE(2)=EXARRAY(IC,2)
. S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
. I IEN=0 D BMES^XPDUTL("Reminder Exchange entry "_LUVALUE(1)_" not properly installed.") Q
. S TEXT="Installing Reminder Exchange entry "_LUVALUE(1)
. D BMES^XPDUTL(TEXT)
. S ACTION=EXARRAY(IC,3)
. D INSTALL^PXRMEXSI(IEN,ACTION,1)
;Map new SECURE MESSAGING Title to Enterprise Standard Title MHV DIALOG NOTE
D MAP($$DT("DOC"))
;Attach new SECURE MESSAGING Document Class to Class PROGRESS NOTES
D ATTACH($$DT("DC"))
Q
;
;==========================================
DT(TYPE) ; Find IEN of SECURE MESSAGING Document Class
N TIUY,POP,TIUNM S (POP,TIUY)=0,TIUNM=$S(TYPE="DOC":"SECURE MESSAGING",1:"SECURE MESSAGING DOCUMENTS")
F S TIUY=$O(^TIU(8925.1,"B",TIUNM,TIUY)) Q:+TIUY'>0 D Q:POP
. I $P($G(^TIU(8925.1,+TIUY,0)),U,4)=TYPE S POP=1
Q TIUY
;
;==========================================
MAP(TIUDA) ; Map new SECURE MESSAGING Title to Enterprise Standard Title MHV DIALOG NOTE
N ERR,IENS,FLAGS,FDA,TIUFPRIV
I +TIUDA'>0 D BMES^XPDUTL("SECURE MESSAGING TITLE NOT PROPERLY INSTALLED.") Q
S TIUFPRIV=1,IENS=TIUDA_","
S FDA(8925.1,IENS,1501)="MHV DIALOG NOTE"
S FDA(8925.1,IENS,1502)=$$FMTE^XLFDT($$NOW^XLFDT)
S FDA(8925.1,IENS,1503)="`"_DUZ
S FLAGS="ET"
D FILE^DIE(FLAGS,"FDA","ERR")
; if filing error occurs, write message to install log & quit
I $D(ERR) D Q
. D BMES^XPDUTL("Unable to map SECURE MESSAGING TITLE to MHV DIALOG NOTE - Please notify CAC.")
; otherwise activate title
K FDA
S FDA(8925.1,IENS,".07")="ACTIVE"
D FILE^DIE(FLAGS,"FDA","ERR")
; if filing error occurs, write message to install log
I $D(ERR) D
. D BMES^XPDUTL("Unable to activate SECURE MESSAGING TITLE - Please notify CAC.")
Q
;
;==========================================
ATTACH(TIUDA) ; Attach new SECURE MESSAGING Document Class to Class PROGRESS NOTES
N D,D0,DI,DIY,DQ,DA,DIC,DLAYGO,DIE,DR,I,TIUI,TIUFPRIV,X,Y,XQORM
I +TIUDA'>0 D BMES^XPDUTL("SECURE MESSAGING DOCUMENT CLASS NOT PROPERLY INSTALLED.") Q
S TIUFPRIV=1
S DIC="^TIU(8925.1,3,10,",DLAYGO=8925.14,DIC(0)="LNX"
S X="`"_TIUDA,DA(1)=3
D ^DIC Q:+Y'>0
S TIUI=$P(^TIU(8925.1,3,10,0),U,4)
S DA(1)=3,DA=+Y,DIE=DIC
S DR="4////Secure Messaging"
D ^DIE
; Serialize menu items
S (DA,TIUI)=0
F S DA=$O(^TIU(8925.1,3,10,DA)) Q:+DA'>0 D
. S TIUI=TIUI+1,DR="2////^S X=TIUI;3////^S X=TIUI" D ^DIE
; Re-compile menu
K ^XUTL("XQORM","3;TIU(8925.1,")
S XQORM="3;TIU(8925.1,",XQORM(0)="" D ^XQORM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUP242 3658 printed Dec 13, 2024@02:42:52 Page 2
TIUP242 ; SLC/JER - Installer Routine for TIU*1*242 ;08/14/2008
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**242**;Jun 20, 1997;Build 7
+2 QUIT
+3 ;=======================================================
PRE ;Pre-install - If the Exchange File entry already exists delete it.
+1 NEW ARRAY,IC,IND,LIST,LUVALUE,NUM
+2 DO EXARRAY(.ARRAY)
+3 SET IC=0
+4 FOR
SET IC=$ORDER(ARRAY(IC))
if 'IC
QUIT
Begin DoDot:1
+5 SET LUVALUE(1)=ARRAY(IC,1)
+6 DO FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
+7 IF '$DATA(LIST)
QUIT
+8 SET NUM=$PIECE(LIST("DILIST",0),U,1)
+9 IF NUM'=0
Begin DoDot:2
+10 FOR IND=1:1:NUM
Begin DoDot:3
+11 NEW DA,DIK
+12 SET DIK="^PXD(811.8,"
+13 SET DA=LIST("DILIST",2,IND)
+14 DO ^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
+17 ;====================================================
EXARRAY(ARRAY) ;List of exchange entries used by delete and install
+1 NEW LN
+2 SET LN=0
+3 ;
+4 SET LN=LN+1
+5 SET ARRAY(LN,1)="TIU*1*242 20080814"
+6 SET ARRAY(LN,2)="08/14/2008@08:20:45"
+7 SET ARRAY(LN,3)="O"
+8 ;
+9 QUIT
+10 ;
+11 ;==========================================
POST ;Post-install.
+1 NEW ACTION,EXARRAY,IC,IEN,LUVALUE,PXRMINST,TEXT,TIUDC,TIUFPRIV
+2 SET (PXRMINST,TIUFPRIV)=1
+3 DO EXARRAY(.EXARRAY)
+4 SET IC=0
+5 FOR
SET IC=$ORDER(EXARRAY(IC))
if 'IC
QUIT
Begin DoDot:1
+6 SET LUVALUE(1)=EXARRAY(IC,1)
SET LUVALUE(2)=EXARRAY(IC,2)
+7 SET IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
+8 IF IEN=0
DO BMES^XPDUTL("Reminder Exchange entry "_LUVALUE(1)_" not properly installed.")
QUIT
+9 SET TEXT="Installing Reminder Exchange entry "_LUVALUE(1)
+10 DO BMES^XPDUTL(TEXT)
+11 SET ACTION=EXARRAY(IC,3)
+12 DO INSTALL^PXRMEXSI(IEN,ACTION,1)
End DoDot:1
+13 ;Map new SECURE MESSAGING Title to Enterprise Standard Title MHV DIALOG NOTE
+14 DO MAP($$DT("DOC"))
+15 ;Attach new SECURE MESSAGING Document Class to Class PROGRESS NOTES
+16 DO ATTACH($$DT("DC"))
+17 QUIT
+18 ;
+19 ;==========================================
DT(TYPE) ; Find IEN of SECURE MESSAGING Document Class
+1 NEW TIUY,POP,TIUNM
SET (POP,TIUY)=0
SET TIUNM=$SELECT(TYPE="DOC":"SECURE MESSAGING",1:"SECURE MESSAGING DOCUMENTS")
+2 FOR
SET TIUY=$ORDER(^TIU(8925.1,"B",TIUNM,TIUY))
if +TIUY'>0
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(^TIU(8925.1,+TIUY,0)),U,4)=TYPE
SET POP=1
End DoDot:1
if POP
QUIT
+4 QUIT TIUY
+5 ;
+6 ;==========================================
MAP(TIUDA) ; Map new SECURE MESSAGING Title to Enterprise Standard Title MHV DIALOG NOTE
+1 NEW ERR,IENS,FLAGS,FDA,TIUFPRIV
+2 IF +TIUDA'>0
DO BMES^XPDUTL("SECURE MESSAGING TITLE NOT PROPERLY INSTALLED.")
QUIT
+3 SET TIUFPRIV=1
SET IENS=TIUDA_","
+4 SET FDA(8925.1,IENS,1501)="MHV DIALOG NOTE"
+5 SET FDA(8925.1,IENS,1502)=$$FMTE^XLFDT($$NOW^XLFDT)
+6 SET FDA(8925.1,IENS,1503)="`"_DUZ
+7 SET FLAGS="ET"
+8 DO FILE^DIE(FLAGS,"FDA","ERR")
+9 ; if filing error occurs, write message to install log & quit
+10 IF $DATA(ERR)
Begin DoDot:1
+11 DO BMES^XPDUTL("Unable to map SECURE MESSAGING TITLE to MHV DIALOG NOTE - Please notify CAC.")
End DoDot:1
QUIT
+12 ; otherwise activate title
+13 KILL FDA
+14 SET FDA(8925.1,IENS,".07")="ACTIVE"
+15 DO FILE^DIE(FLAGS,"FDA","ERR")
+16 ; if filing error occurs, write message to install log
+17 IF $DATA(ERR)
Begin DoDot:1
+18 DO BMES^XPDUTL("Unable to activate SECURE MESSAGING TITLE - Please notify CAC.")
End DoDot:1
+19 QUIT
+20 ;
+21 ;==========================================
ATTACH(TIUDA) ; Attach new SECURE MESSAGING Document Class to Class PROGRESS NOTES
+1 NEW D,D0,DI,DIY,DQ,DA,DIC,DLAYGO,DIE,DR,I,TIUI,TIUFPRIV,X,Y,XQORM
+2 IF +TIUDA'>0
DO BMES^XPDUTL("SECURE MESSAGING DOCUMENT CLASS NOT PROPERLY INSTALLED.")
QUIT
+3 SET TIUFPRIV=1
+4 SET DIC="^TIU(8925.1,3,10,"
SET DLAYGO=8925.14
SET DIC(0)="LNX"
+5 SET X="`"_TIUDA
SET DA(1)=3
+6 DO ^DIC
if +Y'>0
QUIT
+7 SET TIUI=$PIECE(^TIU(8925.1,3,10,0),U,4)
+8 SET DA(1)=3
SET DA=+Y
SET DIE=DIC
+9 SET DR="4////Secure Messaging"
+10 DO ^DIE
+11 ; Serialize menu items
+12 SET (DA,TIUI)=0
+13 FOR
SET DA=$ORDER(^TIU(8925.1,3,10,DA))
if +DA'>0
QUIT
Begin DoDot:1
+14 SET TIUI=TIUI+1
SET DR="2////^S X=TIUI;3////^S X=TIUI"
DO ^DIE
End DoDot:1
+15 ; Re-compile menu
+16 KILL ^XUTL("XQORM","3;TIU(8925.1,")
+17 SET XQORM="3;TIU(8925.1,"
SET XQORM(0)=""
DO ^XQORM
+18 QUIT
