TIUPS112.m

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 ---TIUPS112   2254     printed  Apr 23, 2025@18:58:29                                                                                                                                                                                                    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