TIUPS112 ; SLC/JER - Post-Install for TIU*1*112 ; 02/04/2004
;;1.0;Text Integration Utilities;**112**;Jun 20, 1997
MAIN ; Control subroutine
N DA,TIUDA,TIUFPRIV,TIUFWHO,TIULUV,TEXT
S TIUFPRIV=1,TIUFWHO="N"
; Find REMINDER EXCHANGE file Entry
S TIULUV(1)="TIU*1*112 20040325"
S TIULUV(2)="03/25/2004@14:20:47"
S TIUDA=+$$FIND1^DIC(811.8,"","KU",.TIULUV)
I TIUDA=0 D Q
. S TEXT=" Couldn't find Exchange File for SURGICAL REPORTS..."
. D BMES^XPDUTL(TEXT)
S TEXT=" Installing Document Definitions for SURGICAL REPORTS..."
D BMES^XPDUTL(TEXT)
D POSTKIDS^PXRMEXU5(TIUDA)
D INSTALL^PXRMEXSI(TIUDA)
; Attach the new SURGICAL REPORTS Class to CLINICAL DOCUMENTS
S TIUDA=+$$CLASS("SURGICAL REPORTS")
I 'TIUDA D Q
. D BMES^XPDUTL(" Unable to attach SURGICAL REPORTS to Root Class...")
D ADDITEM(TIUDA)
S TEXT=" Registering RPCs for SURGICAL REPORTS..."
D BMES^XPDUTL(TEXT)
D REG
Q
CLASS(TIUDNM) ; Find the class
N TIUY,POP S (POP,TIUY)=0
F S TIUY=$O(^TIU(8925.1,"B",TIUDNM,TIUY)) Q:+TIUY'>0 D Q:POP
. I $P($G(^TIU(8925.1,+TIUY,0)),U,4)="CL" S POP=1
Q TIUY
ADDITEM(TIUDA) ; Add SURGICAL REPORTS to CLINICAL DOCUMENTS
N D,D0,DI,DIY,DQ,DA,DIC,DLAYGO,DIE,DR,I,TIUI,TIUFPRIV,X,Y,XQORM
S TIUFPRIV=1
S DIC="^TIU(8925.1,38,10,",DLAYGO=8925.14,DIC(0)="LNX"
S X="`"_TIUDA,DA(1)=38
D ^DIC Q:+Y'>0
S TIUI=$P(^TIU(8925.1,38,10,0),U,4)
S DA(1)=38,DA=+Y,DIE=DIC
S DR="4////Surgical Reports"
D ^DIE
; Serialize menu items
S (DA,TIUI)=0
F S DA=$O(^TIU(8925.1,38,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","38;TIU(8925.1,")
S XQORM="38;TIU(8925.1,",XQORM(0)="" D ^XQORM
Q
;
REG ; Register RPCs
N MENU,RPC
S MENU="OR CPRS GUI CHART"
F RPC="TIU GET DOCUMENTS FOR REQUEST","TIU IDENTIFY SURGERY CLASS","TIU IS THIS A SURGERY?","TIU LONG LIST SURGERY TITLES" D INSERT(MENU,RPC)
Q
;
INSERT(OPTION,RPC) ; Call FM Updater with each RPC
; Input -- OPTION Option file (#19) Name field (#.01)
; RPC RPC sub-file (#19.05) RPC field (#.01)
; Output -- None
N FDA,FDAIEN,ERR,DIERR
S FDA(19,"?1,",.01)=OPTION
S FDA(19.05,"?+2,?1,",.01)=RPC
D UPDATE^DIE("E","FDA","FDAIEN","ERR")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS112 2254 printed Oct 16, 2024@18:44:32 Page 2
TIUPS112 ; SLC/JER - Post-Install for TIU*1*112 ; 02/04/2004
+1 ;;1.0;Text Integration Utilities;**112**;Jun 20, 1997
MAIN ; Control subroutine
+1 NEW DA,TIUDA,TIUFPRIV,TIUFWHO,TIULUV,TEXT
+2 SET TIUFPRIV=1
SET TIUFWHO="N"
+3 ; Find REMINDER EXCHANGE file Entry
+4 SET TIULUV(1)="TIU*1*112 20040325"
+5 SET TIULUV(2)="03/25/2004@14:20:47"
+6 SET TIUDA=+$$FIND1^DIC(811.8,"","KU",.TIULUV)
+7 IF TIUDA=0
Begin DoDot:1
+8 SET TEXT=" Couldn't find Exchange File for SURGICAL REPORTS..."
+9 DO BMES^XPDUTL(TEXT)
End DoDot:1
QUIT
+10 SET TEXT=" Installing Document Definitions for SURGICAL REPORTS..."
+11 DO BMES^XPDUTL(TEXT)
+12 DO POSTKIDS^PXRMEXU5(TIUDA)
+13 DO INSTALL^PXRMEXSI(TIUDA)
+14 ; Attach the new SURGICAL REPORTS Class to CLINICAL DOCUMENTS
+15 SET TIUDA=+$$CLASS("SURGICAL REPORTS")
+16 IF 'TIUDA
Begin DoDot:1
+17 DO BMES^XPDUTL(" Unable to attach SURGICAL REPORTS to Root Class...")
End DoDot:1
QUIT
+18 DO ADDITEM(TIUDA)
+19 SET TEXT=" Registering RPCs for SURGICAL REPORTS..."
+20 DO BMES^XPDUTL(TEXT)
+21 DO REG
+22 QUIT
CLASS(TIUDNM) ; Find the class
+1 NEW TIUY,POP
SET (POP,TIUY)=0
+2 FOR
SET TIUY=$ORDER(^TIU(8925.1,"B",TIUDNM,TIUY))
if +TIUY'>0
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(^TIU(8925.1,+TIUY,0)),U,4)="CL"
SET POP=1
End DoDot:1
if POP
QUIT
+4 QUIT TIUY
ADDITEM(TIUDA) ; Add SURGICAL REPORTS to CLINICAL DOCUMENTS
+1 NEW D,D0,DI,DIY,DQ,DA,DIC,DLAYGO,DIE,DR,I,TIUI,TIUFPRIV,X,Y,XQORM
+2 SET TIUFPRIV=1
+3 SET DIC="^TIU(8925.1,38,10,"
SET DLAYGO=8925.14
SET DIC(0)="LNX"
+4 SET X="`"_TIUDA
SET DA(1)=38
+5 DO ^DIC
if +Y'>0
QUIT
+6 SET TIUI=$PIECE(^TIU(8925.1,38,10,0),U,4)
+7 SET DA(1)=38
SET DA=+Y
SET DIE=DIC
+8 SET DR="4////Surgical Reports"
+9 DO ^DIE
+10 ; Serialize menu items
+11 SET (DA,TIUI)=0
+12 FOR
SET DA=$ORDER(^TIU(8925.1,38,10,DA))
if +DA'>0
QUIT
Begin DoDot:1
+13 SET TIUI=TIUI+1
SET DR="2////^S X=TIUI;3////^S X=TIUI"
DO ^DIE
End DoDot:1
+14 ; Re-compile menu
+15 KILL ^XUTL("XQORM","38;TIU(8925.1,")
+16 SET XQORM="38;TIU(8925.1,"
SET XQORM(0)=""
DO ^XQORM
+17 QUIT
+18 ;
REG ; Register RPCs
+1 NEW MENU,RPC
+2 SET MENU="OR CPRS GUI CHART"
+3 FOR RPC="TIU GET DOCUMENTS FOR REQUEST","TIU IDENTIFY SURGERY CLASS","TIU IS THIS A SURGERY?","TIU LONG LIST SURGERY TITLES"
DO INSERT(MENU,RPC)
+4 QUIT
+5 ;
INSERT(OPTION,RPC) ; Call FM Updater with each RPC
+1 ; Input -- OPTION Option file (#19) Name field (#.01)
+2 ; RPC RPC sub-file (#19.05) RPC field (#.01)
+3 ; Output -- None
+4 NEW FDA,FDAIEN,ERR,DIERR
+5 SET FDA(19,"?1,",.01)=OPTION
+6 SET FDA(19.05,"?+2,?1,",.01)=RPC
+7 DO UPDATE^DIE("E","FDA","FDAIEN","ERR")
+8 QUIT
