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
Q
;
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.",!!
Q
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
;
Q
;
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"
Q
;
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_"^"_%
;
Q
;
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
Q
;
CONV46 ;Convert 4.5 to 4.6
Q
CONV45 ;Convert 4.4 to 4.5
Q
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
Q
GENERAU ;Generate & compile scripts automatically
W !! D ALLAUTO^INHSGZ
Q
;
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 ;
