KMPSPST ;SF/KAK - SAGG Post Install ;20 FEB 98 2:26 pm [ 03/13/2003 1:32 PM ]
;;1.8;SAGG PROJECT;;May 29, 1998
;
N DA,DIC,DIE,DIK,DIU,DR
PACK ;
D BMES^XPDUTL("PART 1: Updating SAGG PROJECT data in PACKAGE file ...")
S KMPSDA(1)=+$O(^DIC(9.4,"B","SAGG PROJECT",0)) G:'KMPSDA(1) MOV
; Update data in ROUTINE field
K DA,DR S KMPSDA=0 F S KMPSDA=$O(^DIC(9.4,KMPSDA(1),2,KMPSDA)) Q:'+KMPSDA D
.S KMPSIENS=$$IENS^DILF(.KMPSDA)
.K KMPSFDA S KMPSFDA(9.42,KMPSIENS,.01)="@"
.D FILE^DIE("","KMPSFDA","")
S KMPSIENS="+1,"_KMPSDA(1)_","
F I=1:1:2 S KMPSROUT=$P($T(ROUT+I),";;",2) F J=1:1 S KMPSRTN=$P(KMPSROUT,"^",J) Q:KMPSRTN="" D
.K KMPSFDA S KMPSFDA(9.42,KMPSIENS,.01)=KMPSRTN
.D UPDATE^DIE("","KMPSFDA","")
; Update data in GLOBAL field
K DA,DR S DA=0,DA(1)=KMPSDA(1) F S DA=$O(^DIC(9.4,DA(1),3,DA)) Q:'+DA D
.S KMPSGBL=$G(^DIC(9.4,DA(1),3,DA,0)) Q:KMPSGBL=""
.S DIE="^DIC(9.4,"_DA(1)_",3,"
.S DR=".01///"_$S(KMPSGBL="A1B5":"KMPS(8970.1",KMPSGBL="A1B5GE":"XTMP('KMPS'",1:KMPSGBL) D ^DIE
; Update data in FILE field
K DA,DR S DA=0,DA(1)=KMPSDA(1) F S DA=$O(^DIC(9.4,DA(1),4,DA)) Q:'+DA D
.S KMPSFIL=$G(^DIC(9.4,DA(1),4,DA,0)) Q:KMPSFIL=""
.S DIE="^DIC(9.4,"_DA(1)_",4,"
.S DR=".01///"_$S(KMPSFIL=11120:"8970.1",1:KMPSFIL) D ^DIE
; Update data in *LOWEST FILE NUMBER, *HIGHEST FILE NUMBER and
; *POST-INITIALIZATION ROUTINE fields
K DA,DR S DA=KMPSDA(1),DR="10.6///8970.1;11///8970.1;11.3///I;914///@"
S DIE="^DIC(9.4," D ^DIE
D MES^XPDUTL(" Done (Part 1)")
;
MOV ;
D BMES^XPDUTL("PART 2: Moving data from SAGG PROJECT file #11120 to file #8970.1 ...")
I '$D(^KMPS(8970.1)) D BMES^XPDUTL(" ERROR - Missing new file #8970.1.") G ERRM1
I '$D(^A1B5(11120)) D BMES^XPDUTL(" INFO - No data found in old file #11120.") G ERRM2
I '$D(^A1B5(11120,1,1,"B")) D BMES^XPDUTL(" INFO - No VOLUME SET data found in old file #11120.") G ERRM2
S KMPSOS=$P($G(^%ZOSF("OS")),"^")
S (DIC,DIE)="^KMPS(8970.1,",DIC(0)="LZ",DLAYGO=8970.1,X=1
D ^DIC I Y=-1 D BMES^XPDUTL(" ERROR - Unsuccessful in adding entry 1 into file #8970.1") G ERRM2
S ERR=0,KMPSVOL="" F S KMPSVOL=$O(^A1B5(11120,1,1,"B",KMPSVOL)) Q:ERR!(KMPSVOL="") D
.S KMPSUCI=$O(^A1B5(11120,1,1,"B",KMPSVOL,0)),KMPSUCI=$P(^A1B5(11120,1,1,KMPSUCI,0),U,2)
.S DA(1)=1,DLAYGO=8970.1,DIC="^KMPS(8970.1,1,1,",DIC(0)="LZ"
.S DIC("P")=$P(^DD(8970.1,.03,0),U,2),X=KMPSVOL
.D ^DIC I Y=-1 S ERR=1 D BMES^XPDUTL(" ERROR - Unsuccessful in adding VOLUME SET "_KMPSVOL) Q
.S DIE=DIC K DIC
.S DA=+Y,DR=".01///^S X=KMPSVOL"_$S(KMPSOS["DSM":$S(KMPSUCI'="":";.02///^S X=KMPSUCI",1:""),1:"") D ^DIE
I KMPSOS["DSM" D
.K DIE S DA=1,DIE="^KMPS(8970.1,"
.S DR=".02///^S X=XPDQUES(""POSKMPS1"",""B"");.025///^S X=XPDQUES(""POSKMPS2"",""B"")"
.D ^DIE
G:ERR ERRM2
D MES^XPDUTL(" Done (Part 2)")
;
DEL ;
D BMES^XPDUTL("PART 3: Deleting old SAGG PROJECT (#11120) file ...")
K DIC,DIE,DIK S DIK="^A1B5(11120,",DA=1
D ^DIK
S DIU=11120.01,DIU(0)="DST" D EN^DIU2
S DIU="^A1B5(11120,",DIU(0)="DT" D EN^DIU2
D MES^XPDUTL(" Done (Part 3)")
;
TSK ;
D BMES^XPDUTL("PART 4: Rescheduling new KMPS SAGG REPORT background task ...")
N DIFROM,ZTSK K DIFROM
S KMPSDA=$O(^DIC(19,"B","KMPS SAGG REPORT",0)) G:'KMPSDA ERRT
S KMPSDA=$O(^DIC(19.2,"B",KMPSDA,0)) G:'KMPSDA ERRT
S KMPSDTH=$P($G(^DIC(19.2,KMPSDA,0)),"^",2),ZTSK=+$G(^DIC(19.2,KMPSDA,1))
I ZTSK D KILL^%ZTLOAD K DR S DA=KMPSDA,DIE="^DIC(19.2,",DR="12///@" D ^DIE
I KMPSDTH="" G ERRT
K DR S DA=KMPSDA,DIE="^DIC(19.2,",DR="2///@" D ^DIE
I KMPSDTH<DT G ERRT
K DR S DA=KMPSDA,DIE="^DIC(19.2,",DR="2////"_KMPSDTH D ^DIE
I '+$G(^DIC(19.2,KMPSDA,1)) G ERRT
D MES^XPDUTL(" Done (Part 4)")
;
GBL ;
D BMES^XPDUTL("PART 5: Deleting old A1B5GE temporary collection global ...")
S KMPSSITE=$G(^DD("SITE",1)) I KMPSSITE'="" K ^A1B5GE(KMPSSITE)
K ^A1B5GE("ERROR"),^A1B5GE("START"),^A1B5GE("STOP")
D MES^XPDUTL(" Done (Part 5)")
;
D BMES^XPDUTL("Post-install routine complete.")
EXIT ;
K DA,DIC,DIE,DIK,DIU,DLAYGO,DR,ERR
K KMPSDA,KMPSFDA,KMPSDTH,KMPSFIL,KMPSGBL,KMPSIENS,KMPSOS,KMPSRTN,KMPSSITE,KMPSUCI,KMPSVOL,X
Q
ERRM1 ;
D MES^XPDUTL(" Please correct the ERROR condition.")
D MES^XPDUTL(" Then re-run routine MOV^KMPSPST.")
G EXIT
ERRM2 ;
D MES^XPDUTL(" Enter data manually with 'Edit SAGG Project File'")
D MES^XPDUTL(" [KMPS SAGG FILE] option.")
G DEL
ERRT ;
D MES^XPDUTL(" ERROR - Not able to reschedule new KMPS SAGG REPORT background task.")
D MES^XPDUTL(" Use 'Schedule/Unschedule Options' [XUTM SCHEDULE] to reschedule")
D MES^XPDUTL(" the 'SAGG Master Background Task' [KMPS SAGG REPORT].")
G GBL
;
ROUT ; Names of routines
;;KMPSENV^KMPSGE^KMPSLK^KMPSLOAD^KMPSPRE^KMPSPST^KMPSUTL
;;ZKMPSGEM^ZKMPSGEN^ZKMPSGEV^ZKMPSGSM^ZKMPSGSN^ZKMPSGSV
KMPSPST ;SF/KAK - SAGG Post Install ;20 FEB 98 2:26 pm [ 03/13/2003 1:32 PM ]
+1 ;;1.8;SAGG PROJECT;;May 29, 1998
+2 ;
+3 NEW DA,DIC,DIE,DIK,DIU,DR
PACK ;
+1 DO BMES^XPDUTL("PART 1: Updating SAGG PROJECT data in PACKAGE file ...")
+2 SET KMPSDA(1)=+$ORDER(^DIC(9.4,"B","SAGG PROJECT",0))
IF 'KMPSDA(1)
GOTO MOV
+3 ; Update data in ROUTINE field
+4 KILL DA,DR
SET KMPSDA=0
FOR
SET KMPSDA=$ORDER(^DIC(9.4,KMPSDA(1),2,KMPSDA))
IF '+KMPSDA
QUIT
Begin DoDot:1
+5 SET KMPSIENS=$$IENS^DILF(.KMPSDA)
+6 KILL KMPSFDA
SET KMPSFDA(9.42,KMPSIENS,.01)="@"
+7 DO FILE^DIE("","KMPSFDA","")
End DoDot:1
+8 SET KMPSIENS="+1,"_KMPSDA(1)_","
+9 FOR I=1:1:2
SET KMPSROUT=$PIECE($TEXT(ROUT+I),";;",2)
FOR J=1:1
SET KMPSRTN=$PIECE(KMPSROUT,"^",J)
IF KMPSRTN=""
QUIT
Begin DoDot:1
+10 KILL KMPSFDA
SET KMPSFDA(9.42,KMPSIENS,.01)=KMPSRTN
+11 DO UPDATE^DIE("","KMPSFDA","")
End DoDot:1
+12 ; Update data in GLOBAL field
+13 KILL DA,DR
SET DA=0
SET DA(1)=KMPSDA(1)
FOR
SET DA=$ORDER(^DIC(9.4,DA(1),3,DA))
IF '+DA
QUIT
Begin DoDot:1
+14 SET KMPSGBL=$GET(^DIC(9.4,DA(1),3,DA,0))
IF KMPSGBL=""
QUIT
+15 SET DIE="^DIC(9.4,"_DA(1)_",3,"
+16 SET DR=".01///"_$SELECT(KMPSGBL="A1B5":"KMPS(8970.1",KMPSGBL="A1B5GE":"XTMP('KMPS'",1:KMPSGBL)
DO ^DIE
End DoDot:1
+17 ; Update data in FILE field
+18 KILL DA,DR
SET DA=0
SET DA(1)=KMPSDA(1)
FOR
SET DA=$ORDER(^DIC(9.4,DA(1),4,DA))
IF '+DA
QUIT
Begin DoDot:1
+19 SET KMPSFIL=$GET(^DIC(9.4,DA(1),4,DA,0))
IF KMPSFIL=""
QUIT
+20 SET DIE="^DIC(9.4,"_DA(1)_",4,"
+21 SET DR=".01///"_$SELECT(KMPSFIL=11120:"8970.1",1:KMPSFIL)
DO ^DIE
End DoDot:1
+22 ; Update data in *LOWEST FILE NUMBER, *HIGHEST FILE NUMBER and
+23 ; *POST-INITIALIZATION ROUTINE fields
+24 KILL DA,DR
SET DA=KMPSDA(1)
SET DR="10.6///8970.1;11///8970.1;11.3///I;914///@"
+25 SET DIE="^DIC(9.4,"
DO ^DIE
+26 DO MES^XPDUTL(" Done (Part 1)")
+27 ;
MOV ;
+1 DO BMES^XPDUTL("PART 2: Moving data from SAGG PROJECT file #11120 to file #8970.1 ...")
+2 IF '$DATA(^KMPS(8970.1))
DO BMES^XPDUTL(" ERROR - Missing new file #8970.1.")
GOTO ERRM1
+3 IF '$DATA(^A1B5(11120))
DO BMES^XPDUTL(" INFO - No data found in old file #11120.")
GOTO ERRM2
+4 IF '$DATA(^A1B5(11120,1,1,"B"))
DO BMES^XPDUTL(" INFO - No VOLUME SET data found in old file #11120.")
GOTO ERRM2
+5 SET KMPSOS=$PIECE($GET(^%ZOSF("OS")),"^")
+6 SET (DIC,DIE)="^KMPS(8970.1,"
SET DIC(0)="LZ"
SET DLAYGO=8970.1
SET X=1
+7 DO ^DIC
IF Y=-1
DO BMES^XPDUTL(" ERROR - Unsuccessful in adding entry 1 into file #8970.1")
GOTO ERRM2
+8 SET ERR=0
SET KMPSVOL=""
FOR
SET KMPSVOL=$ORDER(^A1B5(11120,1,1,"B",KMPSVOL))
IF ERR!(KMPSVOL="")
QUIT
Begin DoDot:1
+9 SET KMPSUCI=$ORDER(^A1B5(11120,1,1,"B",KMPSVOL,0))
SET KMPSUCI=$PIECE(^A1B5(11120,1,1,KMPSUCI,0),U,2)
+10 SET DA(1)=1
SET DLAYGO=8970.1
SET DIC="^KMPS(8970.1,1,1,"
SET DIC(0)="LZ"
+11 SET DIC("P")=$PIECE(^DD(8970.1,.03,0),U,2)
SET X=KMPSVOL
+12 DO ^DIC
IF Y=-1
SET ERR=1
DO BMES^XPDUTL(" ERROR - Unsuccessful in adding VOLUME SET "_KMPSVOL)
QUIT
+13 SET DIE=DIC
KILL DIC
+14 SET DA=+Y
SET DR=".01///^S X=KMPSVOL"_$SELECT(KMPSOS["DSM":$SELECT(KMPSUCI'="":";.02///^S X=KMPSUCI",1:""),1:"")
DO ^DIE
End DoDot:1
+15 IF KMPSOS["DSM"
Begin DoDot:1
+16 KILL DIE
SET DA=1
SET DIE="^KMPS(8970.1,"
+17 SET DR=".02///^S X=XPDQUES(""POSKMPS1"",""B"");.025///^S X=XPDQUES(""POSKMPS2"",""B"")"
+18 DO ^DIE
End DoDot:1
+19 IF ERR
GOTO ERRM2
+20 DO MES^XPDUTL(" Done (Part 2)")
+21 ;
DEL ;
+1 DO BMES^XPDUTL("PART 3: Deleting old SAGG PROJECT (#11120) file ...")
+2 KILL DIC,DIE,DIK
SET DIK="^A1B5(11120,"
SET DA=1
+3 DO ^DIK
+4 SET DIU=11120.01
SET DIU(0)="DST"
DO EN^DIU2
+5 SET DIU="^A1B5(11120,"
SET DIU(0)="DT"
DO EN^DIU2
+6 DO MES^XPDUTL(" Done (Part 3)")
+7 ;
TSK ;
+1 DO BMES^XPDUTL("PART 4: Rescheduling new KMPS SAGG REPORT background task ...")
+2 NEW DIFROM,ZTSK
KILL DIFROM
+3 SET KMPSDA=$ORDER(^DIC(19,"B","KMPS SAGG REPORT",0))
IF 'KMPSDA
GOTO ERRT
+4 SET KMPSDA=$ORDER(^DIC(19.2,"B",KMPSDA,0))
IF 'KMPSDA
GOTO ERRT
+5 SET KMPSDTH=$PIECE($GET(^DIC(19.2,KMPSDA,0)),"^",2)
SET ZTSK=+$GET(^DIC(19.2,KMPSDA,1))
+6 IF ZTSK
DO KILL^%ZTLOAD
KILL DR
SET DA=KMPSDA
SET DIE="^DIC(19.2,"
SET DR="12///@"
DO ^DIE
+7 IF KMPSDTH=""
GOTO ERRT
+8 KILL DR
SET DA=KMPSDA
SET DIE="^DIC(19.2,"
SET DR="2///@"
DO ^DIE
+9 IF KMPSDTH<DT
GOTO ERRT
+10 KILL DR
SET DA=KMPSDA
SET DIE="^DIC(19.2,"
SET DR="2////"_KMPSDTH
DO ^DIE
+11 IF '+$GET(^DIC(19.2,KMPSDA,1))
GOTO ERRT
+12 DO MES^XPDUTL(" Done (Part 4)")
+13 ;
GBL ;
+1 DO BMES^XPDUTL("PART 5: Deleting old A1B5GE temporary collection global ...")
+2 SET KMPSSITE=$GET(^DD("SITE",1))
IF KMPSSITE'=""
KILL ^A1B5GE(KMPSSITE)
+3 KILL ^A1B5GE("ERROR"),^A1B5GE("START"),^A1B5GE("STOP")
+4 DO MES^XPDUTL(" Done (Part 5)")
+5 ;
+6 DO BMES^XPDUTL("Post-install routine complete.")
EXIT ;
+1 KILL DA,DIC,DIE,DIK,DIU,DLAYGO,DR,ERR
+2 KILL KMPSDA,KMPSFDA,KMPSDTH,KMPSFIL,KMPSGBL,KMPSIENS,KMPSOS,KMPSRTN,KMPSSITE,KMPSUCI,KMPSVOL,X
+3 QUIT
ERRM1 ;
+1 DO MES^XPDUTL(" Please correct the ERROR condition.")
+2 DO MES^XPDUTL(" Then re-run routine MOV^KMPSPST.")
+3 GOTO EXIT
ERRM2 ;
+1 DO MES^XPDUTL(" Enter data manually with 'Edit SAGG Project File'")
+2 DO MES^XPDUTL(" [KMPS SAGG FILE] option.")
+3 GOTO DEL
ERRT ;
+1 DO MES^XPDUTL(" ERROR - Not able to reschedule new KMPS SAGG REPORT background task.")
+2 DO MES^XPDUTL(" Use 'Schedule/Unschedule Options' [XUTM SCHEDULE] to reschedule")
+3 DO MES^XPDUTL(" the 'SAGG Master Background Task' [KMPS SAGG REPORT].")
+4 GOTO GBL
+5 ;
ROUT ; Names of routines
+1 ;;KMPSENV^KMPSGE^KMPSLK^KMPSLOAD^KMPSPRE^KMPSPST^KMPSUTL
+2 ;;ZKMPSGEM^ZKMPSGEN^ZKMPSGEV^ZKMPSGSM^ZKMPSGSN^ZKMPSGSV
