Routine: INHPOST

INHPOST ; FRW,JSH ; 13 Sep 1999 15:23;Interface - PostInit routine

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

POST ;Post-init for GIS subsystem

 S X="ERR^INHPOST",@^%ZOSF("TRAP")

 ; Set FILEMAN environment

 D ENV^UTIL

 W !!,"Running Generic Interface Post-Init..."

 ;Set up Interface Site Parameter file

 D SPAR

 ;Set up Interface Operating System file

 D OS

 ;Set up format controller & output controller

 D CONT

 ;Generate & compile scripts

 D GENERAU

 ;Run 4.5 to 4.6 conversion

 D CONV46

 ;Restore env data

 D RESTORE

RESTORE ;Rstore site specific control file data

 N DATE,INTITLE

 S INTITLE="4604 Inst"

 S DATE=$O(^UTILITY("INSAVE",INTITLE,"A"),-1)

 I 'DATE W !!,"No GIS site specifc data found to restore!",!! Q

 I '$$RESTORE^INHSYSUL(INTITLE,DATE) W !!,"NOTE: Exceptions in restoring GIS Site specific fields.",!!

SPAR ;Site Paramter file (#4002)

 Q:$D(^INRHSITE(1,0))#2

 N DA,DIC,DIK,Y,X

 I '($D(^XMB(1,1,0))#2) W *7,!!,"WARNING!  The KERNEL SITE PARAMTER file does not have an entry number 1.","The Interface Site Parameter file will be set up anyway.",!!

 S ^INRHSITE(1,0)=1,DA=1,DIK="^INRHSITE(" D IX1^DIK

 S $P(^INRHSITE(0),U,3,4)="1^1"

 ;Populate required fields

 ;Output controller hang time

 S $P(^INRHSITE(1,0),U,4)=2

 ;Format controller hang time

 S $P(^INRHSITE(1,0),U,5)=2

 ;Max number of output jobs

 S $P(^INRHSITE(1,0),U,7)=5

 ;Hang after starting a job

 S $P(^INRHSITE(1,0),U,9)=1

 ;Max number of formatter jobs

 S $P(^INRHSITE(1,0),U,10)=5

 ;Variable storage

 S $P(^INRHSITE(1,0),U,12)=0

 ;Minutes to be current

 S $P(^INRHSITE(1,0),U,13)=120

 ;$S for variable overflow

 S $P(^INRHSITE(1,0),U,14)=15000

 ;Code to build user variables

 S ^INRHSITE(1,1)="D DVARS^XQ1"

 ;Output controller mode

 S $P(^INRHSITE(1,2),U,1)=1

 ;Output server wait time

 S $P(^INRHSITE(1,2),U,2)=600

 ;Format controller mode

 S $P(^INRHSITE(1,2),U,3)=1

 ;Format server wait time

 S $P(^INRHSITE(1,2),U,4)=600

 ;Default retry rate

 S $P(^INRHSITE(1,0),U,3)="5M"

 ;Default max number of attempts

 S $P(^INRHSITE(1,0),U,2)=2

 ;UIF/error retention days

 S $P(^INRHSITE(1,0),U,11)=15

 ;Message ID prefix

 S X="",Y=+$G(^DD("SITE",1)) I Y S Y=$P($G(^DIC(4,Y,8000)),U,1) I $L(Y) S Y=Y_"-",X=Y

 S $P(^INRHSITE(1,0),U,8)=X

 S DA=1,DIK="^INRHSITE(" D IX1^DIK

OS ;Operating System file (4002.1)

 Q:$D(^INTHOS(1,0))#2

 N DA,DIC,DIK,Y,X

 S INOS=+$G(^DD("OS"))

 I 'INOS D

 .  W *7,!!,"WARNING!  Unable to detemine the type of MUMPS operating system you are using.",!!

 .  F  D  Q:+Y>0

 ..    S DIC(0)="AEMNQ",DIC="^DD(""OS""," D ^DIC S INOS=+Y

 ..    I +Y<0 W *7,!!,"Please select the MUMPS operating system you are using!",!

 S ^INTHOS(1,0)=INOS,DA=1,DIK="^INTHOS(" D IX1^DIK

 S $P(^INTHOS(0),U,3,4)="1^1"

 ;Populate required fields

 S ^INTHOS(1,1)="J *"

 S ^INTHOS(1,2)="D TMENV^%ZTOS"

 S ^INTHOS(1,3)="D ^%ET"

CONT ;Set up format controller & output controller

 ;Build the Output Controller and Format Controller entries in the

 ;  Background Process Control file (#4004)

 N G,DIK,DA

 S G=^DIC(4004,0,"GL")

 I '$D(^INTHPC(1,0)) K ^INTHPC(1) S ^INTHPC(1,0)="OUTPUT CONTROLLER^1",^("ROU")="INHOTM",DIK=G,DA=1 D IX1^DIK W !?5,"Output Controller created."

 I '$D(^INTHPC(2,0)) K ^INTHPC(2) S ^INTHPC(2,0)="FORMAT CONTROLLER^1",^("ROU")="INHFTM",DIK=G,DA=2 D IX1^DIK W !?5,"Format Controller created."

 S (%,I)=0 F  Q:'$O(^INTHPC(I))  S %=%+1,I=$O(^INTHPC(I))

 S $P(^INTHPC(0),U,3,4)=I_"^"_%

GENER ;Generate & compile scripts

 W !!

 S X=$$YN^UTSRD("Do you want to regenerate all messages? ;1","") D:X ALL^INHSGZ

 W !!

 S X=$$YN^UTSRD("Do you want to recompile all scripts? ;1","") D:X RECOMP^INHSZ

CONV46 ;Convert 4.5 to 4.6

CONV45 ;Convert 4.4 to 4.5

 N DA,I,INDT I $O(^INLHFTSK(0)) D

 . W !,"Converting FORMAT CONTROLLER queue - ^INLHFTSK - from version 4.4 to 4.5",!

 . L +^INLHFTSK K ^INLHFTSK(-1)

 . S DA=0 F  S DA=$O(^INLHFTSK(DA)) Q:'DA  D

 . . I $D(^INLHFTSK(DA,0))>10 M ^INLHFTSK(DA,2)=^INLHFTSK(DA,0) S ^INLHFTSK(DA,2)=""

 W !,"Converting SITE PARAMETERS - ^INRHSITE - from version 4.4 to 4.5"

 L -^INLHFTSK,+^INRHSITE S DA=^INRHSITE(1,0) F I=7,10 S INDT=$P(DA,U,I) I INDT<3 S $P(DA,U,I)=3

 S ^INRHSITE(1,0)=DA L -^INRHSITE

GENERAU ;Generate & compile scripts automatically

 W !! D ALLAUTO^INHSGZ

INHPOST   ; FRW,JSH ; 13 Sep 1999 15:23;Interface - PostInit routine

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;

POST      ;Post-init for GIS subsystem

 +1       ;

 +2        SET X="ERR^INHPOST"

           SET @^%ZOSF("TRAP")

 +3       ; Set FILEMAN environment

 +4        DO ENV^UTIL

 +5        WRITE !!,"Running Generic Interface Post-Init..."

 +6       ;Set up Interface Site Parameter file

 +7        DO SPAR

 +8       ;Set up Interface Operating System file

 +9        DO OS

 +10      ;Set up format controller & output controller

 +11       DO CONT

 +12      ;Generate & compile scripts

 +13       DO GENERAU

 +14      ;Run 4.5 to 4.6 conversion

 +15       DO CONV46

 +16      ;Restore env data

 +17       DO RESTORE

 +18       QUIT

 +19      ;

RESTORE   ;Rstore site specific control file data

 +1        NEW DATE,INTITLE

 +2        SET INTITLE="4604 Inst"

 +3        SET DATE=$ORDER(^UTILITY("INSAVE",INTITLE,"A"),-1)

 +4        IF 'DATE

               WRITE !!,"No GIS site specifc data found to restore!",!!

               QUIT

 +5        IF '$$RESTORE^INHSYSUL(INTITLE,DATE)

               WRITE !!,"NOTE: Exceptions in restoring GIS Site specific fields.",!!

 +6        QUIT

SPAR      ;Site Paramter file (#4002)

 +1        IF $DATA(^INRHSITE(1,0))#2

               QUIT

 +2        NEW DA,DIC,DIK,Y,X

 +3        IF '($DATA(^XMB(1,1,0))#2)

               WRITE *7,!!,"WARNING!  The KERNEL SITE PARAMTER file does not have an entry number 1.","The Interface Site Parameter file will be set up anyway.",!!

 +4        SET ^INRHSITE(1,0)=1

           SET DA=1

           SET DIK="^INRHSITE("

           DO IX1^DIK

 +5        SET $PIECE(^INRHSITE(0),U,3,4)="1^1"

 +6       ;Populate required fields

 +7       ;Output controller hang time

 +8        SET $PIECE(^INRHSITE(1,0),U,4)=2

 +9       ;Format controller hang time

 +10       SET $PIECE(^INRHSITE(1,0),U,5)=2

 +11      ;Max number of output jobs

 +12       SET $PIECE(^INRHSITE(1,0),U,7)=5

 +13      ;Hang after starting a job

 +14       SET $PIECE(^INRHSITE(1,0),U,9)=1

 +15      ;Max number of formatter jobs

 +16       SET $PIECE(^INRHSITE(1,0),U,10)=5

 +17      ;Variable storage

 +18       SET $PIECE(^INRHSITE(1,0),U,12)=0

 +19      ;Minutes to be current

 +20       SET $PIECE(^INRHSITE(1,0),U,13)=120

 +21      ;$S for variable overflow

 +22       SET $PIECE(^INRHSITE(1,0),U,14)=15000

 +23      ;Code to build user variables

 +24       SET ^INRHSITE(1,1)="D DVARS^XQ1"

 +25      ;Output controller mode

 +26       SET $PIECE(^INRHSITE(1,2),U,1)=1

 +27      ;Output server wait time

 +28       SET $PIECE(^INRHSITE(1,2),U,2)=600

 +29      ;Format controller mode

 +30       SET $PIECE(^INRHSITE(1,2),U,3)=1

 +31      ;Format server wait time

 +32       SET $PIECE(^INRHSITE(1,2),U,4)=600

 +33      ;Default retry rate

 +34       SET $PIECE(^INRHSITE(1,0),U,3)="5M"

 +35      ;Default max number of attempts

 +36       SET $PIECE(^INRHSITE(1,0),U,2)=2

 +37      ;UIF/error retention days

 +38       SET $PIECE(^INRHSITE(1,0),U,11)=15

 +39      ;Message ID prefix

 +40       SET X=""

           SET Y=+$GET(^DD("SITE",1))

           IF Y

               SET Y=$PIECE($GET(^DIC(4,Y,8000)),U,1)

               IF $LENGTH(Y)

                   SET Y=Y_"-"

                   SET X=Y

 +41       SET $PIECE(^INRHSITE(1,0),U,8)=X

 +42      ;

 +43       SET DA=1

           SET DIK="^INRHSITE("

           DO IX1^DIK

 +44      ;

 +45       QUIT

 +46      ;

OS        ;Operating System file (4002.1)

 +1        IF $DATA(^INTHOS(1,0))#2

               QUIT

 +2        NEW DA,DIC,DIK,Y,X

 +3        SET INOS=+$GET(^DD("OS"))

 +4        IF 'INOS

               Begin DoDot:1

 +5                WRITE *7,!!,"WARNING!  Unable to detemine the type of MUMPS operating system you are using.",!!

 +6                FOR

                       Begin DoDot:2

 +7                        SET DIC(0)="AEMNQ"

                           SET DIC="^DD(""OS"","

                           DO ^DIC

                           SET INOS=+Y

 +8                        IF +Y<0

                               WRITE *7,!!,"Please select the MUMPS operating system you are using!",!

                       End DoDot:2

                       IF +Y>0

                           QUIT

               End DoDot:1

 +9        SET ^INTHOS(1,0)=INOS

           SET DA=1

           SET DIK="^INTHOS("

           DO IX1^DIK

 +10       SET $PIECE(^INTHOS(0),U,3,4)="1^1"

 +11      ;Populate required fields

 +12       SET ^INTHOS(1,1)="J *"

 +13       SET ^INTHOS(1,2)="D TMENV^%ZTOS"

 +14       SET ^INTHOS(1,3)="D ^%ET"

 +15       QUIT

 +16      ;

CONT      ;Set up format controller & output controller

 +1       ;Build the Output Controller and Format Controller entries in the

 +2       ;  Background Process Control file (#4004)

 +3        NEW G,DIK,DA

 +4        SET G=^DIC(4004,0,"GL")

 +5        IF '$DATA(^INTHPC(1,0))

               KILL ^INTHPC(1)

               SET ^INTHPC(1,0)="OUTPUT CONTROLLER^1"

               SET ^("ROU")="INHOTM"

               SET DIK=G

               SET DA=1

               DO IX1^DIK

               WRITE !?5,"Output Controller created."

 +6        IF '$DATA(^INTHPC(2,0))

               KILL ^INTHPC(2)

               SET ^INTHPC(2,0)="FORMAT CONTROLLER^1"

               SET ^("ROU")="INHFTM"

               SET DIK=G

               SET DA=2

               DO IX1^DIK

               WRITE !?5,"Format Controller created."

 +7        SET (%,I)=0

FOR

               IF '$ORDER(^INTHPC(I))

                   QUIT

               SET %=%+1

               SET I=$ORDER(^INTHPC(I))

 +8        SET $PIECE(^INTHPC(0),U,3,4)=I_"^"_%

 +9       ;

 +10       QUIT

 +11      ;

GENER     ;Generate & compile scripts

 +1       ;

 +2        WRITE !!

 +3        SET X=$$YN^UTSRD("Do you want to regenerate all messages? ;1","")

           IF X

               DO ALL^INHSGZ

 +4        WRITE !!

 +5        SET X=$$YN^UTSRD("Do you want to recompile all scripts? ;1","")

           IF X

               DO RECOMP^INHSZ

 +6        QUIT

 +7       ;

CONV46    ;Convert 4.5 to 4.6

 +1        QUIT

CONV45    ;Convert 4.4 to 4.5

 +1        QUIT

 +2        NEW DA,I,INDT

           IF $ORDER(^INLHFTSK(0))

               Begin DoDot:1

 +3                WRITE !,"Converting FORMAT CONTROLLER queue - ^INLHFTSK - from version 4.4 to 4.5",!

 +4                LOCK +^INLHFTSK

                   KILL ^INLHFTSK(-1)

 +5                SET DA=0

FOR

                       SET DA=$ORDER(^INLHFTSK(DA))

                       IF 'DA

                           QUIT

                       Begin DoDot:2

 +6                        IF $DATA(^INLHFTSK(DA,0))>10

                               MERGE ^INLHFTSK(DA,2)=^INLHFTSK(DA,0)

                               SET ^INLHFTSK(DA,2)=""

                       End DoDot:2

               End DoDot:1

 +7        WRITE !,"Converting SITE PARAMETERS - ^INRHSITE - from version 4.4 to 4.5"

 +8        LOCK -^INLHFTSK,+^INRHSITE

           SET DA=^INRHSITE(1,0)

           FOR I=7,10

               SET INDT=$PIECE(DA,U,I)

               IF INDT<3

                   SET $PIECE(DA,U,I)=3

 +9        SET ^INRHSITE(1,0)=DA

           LOCK -^INRHSITE

 +10       QUIT

GENERAU   ;Generate & compile scripts automatically

 +1        WRITE !!

           DO ALLAUTO^INHSGZ

 +2        QUIT

 +3       ;

INHPOST.m