Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: KMPSPST

KMPSPST.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  N DA,DIC,DIE,DIK,DIU,DR
  1. PACK ;
  1.  D BMES^XPDUTL("PART 1: Updating SAGG PROJECT data in PACKAGE file ...")
  1.  S KMPSDA(1)=+$O(^DIC(9.4,"B","SAGG PROJECT",0)) G:'KMPSDA(1) MOV
  1.  ; Update data in ROUTINE field
  1.  K DA,DR S KMPSDA=0 F  S KMPSDA=$O(^DIC(9.4,KMPSDA(1),2,KMPSDA)) Q:'+KMPSDA  D
  1.  .S KMPSIENS=$$IENS^DILF(.KMPSDA)
  1.  .K KMPSFDA S KMPSFDA(9.42,KMPSIENS,.01)="@"
  1.  .D FILE^DIE("","KMPSFDA","")
  1.  S KMPSIENS="+1,"_KMPSDA(1)_","
  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
  1.  .K KMPSFDA S KMPSFDA(9.42,KMPSIENS,.01)=KMPSRTN
  1.  .D UPDATE^DIE("","KMPSFDA","")
  1.  ; Update data in GLOBAL field
  1.  K DA,DR S DA=0,DA(1)=KMPSDA(1) F  S DA=$O(^DIC(9.4,DA(1),3,DA)) Q:'+DA  D
  1.  .S KMPSGBL=$G(^DIC(9.4,DA(1),3,DA,0)) Q:KMPSGBL=""
  1.  .S DIE="^DIC(9.4,"_DA(1)_",3,"
  1.  .S DR=".01///"_$S(KMPSGBL="A1B5":"KMPS(8970.1",KMPSGBL="A1B5GE":"XTMP('KMPS'",1:KMPSGBL) D ^DIE
  1.  ; Update data in FILE field
  1.  K DA,DR S DA=0,DA(1)=KMPSDA(1) F  S DA=$O(^DIC(9.4,DA(1),4,DA)) Q:'+DA  D
  1.  .S KMPSFIL=$G(^DIC(9.4,DA(1),4,DA,0)) Q:KMPSFIL=""
  1.  .S DIE="^DIC(9.4,"_DA(1)_",4,"
  1.  .S DR=".01///"_$S(KMPSFIL=11120:"8970.1",1:KMPSFIL) D ^DIE
  1.  ; Update data in *LOWEST FILE NUMBER, *HIGHEST FILE NUMBER and
  1.  ; *POST-INITIALIZATION ROUTINE fields
  1.  K DA,DR S DA=KMPSDA(1),DR="10.6///8970.1;11///8970.1;11.3///I;914///@"
  1.  S DIE="^DIC(9.4," D ^DIE
  1.  D MES^XPDUTL("        Done (Part 1)")
  1.  ;
  1. MOV ;
  1.  D BMES^XPDUTL("PART 2: Moving data from SAGG PROJECT file #11120 to file #8970.1 ...")
  1.  I '$D(^KMPS(8970.1)) D BMES^XPDUTL("        ERROR - Missing new file #8970.1.") G ERRM1
  1.  I '$D(^A1B5(11120)) D BMES^XPDUTL("        INFO - No data found in old file #11120.") G ERRM2
  1.  I '$D(^A1B5(11120,1,1,"B")) D BMES^XPDUTL("        INFO - No VOLUME SET data found in old file #11120.") G ERRM2
  1.  S KMPSOS=$P($G(^%ZOSF("OS")),"^")
  1.  S (DIC,DIE)="^KMPS(8970.1,",DIC(0)="LZ",DLAYGO=8970.1,X=1
  1.  D ^DIC I Y=-1 D BMES^XPDUTL("        ERROR - Unsuccessful in adding entry 1 into file #8970.1") G ERRM2
  1.  S ERR=0,KMPSVOL="" F  S KMPSVOL=$O(^A1B5(11120,1,1,"B",KMPSVOL)) Q:ERR!(KMPSVOL="")  D
  1.  .S KMPSUCI=$O(^A1B5(11120,1,1,"B",KMPSVOL,0)),KMPSUCI=$P(^A1B5(11120,1,1,KMPSUCI,0),U,2)
  1.  .S DA(1)=1,DLAYGO=8970.1,DIC="^KMPS(8970.1,1,1,",DIC(0)="LZ"
  1.  .S DIC("P")=$P(^DD(8970.1,.03,0),U,2),X=KMPSVOL
  1.  .D ^DIC I Y=-1 S ERR=1 D BMES^XPDUTL("        ERROR - Unsuccessful in adding VOLUME SET "_KMPSVOL) Q
  1.  .S DIE=DIC K DIC
  1.  .S DA=+Y,DR=".01///^S X=KMPSVOL"_$S(KMPSOS["DSM":$S(KMPSUCI'="":";.02///^S X=KMPSUCI",1:""),1:"") D ^DIE
  1.  I KMPSOS["DSM" D
  1.  .K DIE S DA=1,DIE="^KMPS(8970.1,"
  1.  .S DR=".02///^S X=XPDQUES(""POSKMPS1"",""B"");.025///^S X=XPDQUES(""POSKMPS2"",""B"")"
  1.  .D ^DIE
  1.  G:ERR ERRM2
  1.  D MES^XPDUTL("        Done (Part 2)")
  1.  ;
  1. DEL ;
  1.  D BMES^XPDUTL("PART 3: Deleting old SAGG PROJECT (#11120) file ...")
  1.  K DIC,DIE,DIK S DIK="^A1B5(11120,",DA=1
  1.  D ^DIK
  1.  S DIU=11120.01,DIU(0)="DST" D EN^DIU2
  1.  S DIU="^A1B5(11120,",DIU(0)="DT" D EN^DIU2
  1.  D MES^XPDUTL("        Done (Part 3)")
  1.  ;
  1. TSK ;
  1.  D BMES^XPDUTL("PART 4: Rescheduling new KMPS SAGG REPORT background task ...")
  1.  N DIFROM,ZTSK K DIFROM
  1.  S KMPSDA=$O(^DIC(19,"B","KMPS SAGG REPORT",0)) G:'KMPSDA ERRT
  1.  S KMPSDA=$O(^DIC(19.2,"B",KMPSDA,0)) G:'KMPSDA ERRT
  1.  S KMPSDTH=$P($G(^DIC(19.2,KMPSDA,0)),"^",2),ZTSK=+$G(^DIC(19.2,KMPSDA,1))
  1.  I ZTSK D KILL^%ZTLOAD K DR S DA=KMPSDA,DIE="^DIC(19.2,",DR="12///@" D ^DIE
  1.  I KMPSDTH="" G ERRT
  1.  K DR S DA=KMPSDA,DIE="^DIC(19.2,",DR="2///@" D ^DIE
  1.  I KMPSDTH<DT G ERRT
  1.  K DR S DA=KMPSDA,DIE="^DIC(19.2,",DR="2////"_KMPSDTH D ^DIE
  1.  I '+$G(^DIC(19.2,KMPSDA,1)) G ERRT
  1.  D MES^XPDUTL("        Done (Part 4)")
  1.  ;
  1. GBL ;
  1.  D BMES^XPDUTL("PART 5: Deleting old A1B5GE temporary collection global ...")
  1.  S KMPSSITE=$G(^DD("SITE",1)) I KMPSSITE'="" K ^A1B5GE(KMPSSITE)
  1.  K ^A1B5GE("ERROR"),^A1B5GE("START"),^A1B5GE("STOP")
  1.  D MES^XPDUTL("        Done (Part 5)")
  1.  ;
  1.  D BMES^XPDUTL("Post-install routine complete.")
  1. EXIT ;
  1.  K DA,DIC,DIE,DIK,DIU,DLAYGO,DR,ERR
  1.  K KMPSDA,KMPSFDA,KMPSDTH,KMPSFIL,KMPSGBL,KMPSIENS,KMPSOS,KMPSRTN,KMPSSITE,KMPSUCI,KMPSVOL,X
  1.  Q
  1. ERRM1 ;
  1.  D MES^XPDUTL("        Please correct the ERROR condition.")
  1.  D MES^XPDUTL("        Then re-run routine MOV^KMPSPST.")
  1.  G EXIT
  1. ERRM2 ;
  1.  D MES^XPDUTL("        Enter data manually with 'Edit SAGG Project File'")
  1.  D MES^XPDUTL("        [KMPS SAGG FILE] option.")
  1.  G DEL
  1. ERRT ;
  1.  D MES^XPDUTL("        ERROR - Not able to reschedule new KMPS SAGG REPORT background task.")
  1.  D MES^XPDUTL("        Use 'Schedule/Unschedule Options' [XUTM SCHEDULE] to reschedule")
  1.  D MES^XPDUTL("        the 'SAGG Master Background Task' [KMPS SAGG REPORT].")
  1.  G GBL
  1.  ;
  1. ROUT ; Names of routines
  1.  ;;KMPSENV^KMPSGE^KMPSLK^KMPSLOAD^KMPSPRE^KMPSPST^KMPSUTL
  1.  ;;ZKMPSGEM^ZKMPSGEN^ZKMPSGEV^ZKMPSGSM^ZKMPSGSN^ZKMPSGSV