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

GMPLY49A.m

Go to the documentation of this file. 
  1. GMPLY49A ;ISP/TC - Problem Selection List Files Data Migration ;08/22/17  11:32
  1.  ;;2.0;Problem List;**49**;Aug 25, 1994;Build 43
  1.  ;
  1.  ; External References:
  1.  ;   ICR  2053   FILE/UPDATE^DIE
  1.  ;   ICR  10103  $$DT^XLFDT
  1.  ;   ICR  10141  MES/BMES^XPDUTL
  1.  ;
  1. EN ;
  1.  N GMPLTXT,GMPLTXTC
  1.  D SETCLASS("125",4,".04") ; Set for selection lists
  1.  D SETCLASS("125.11",3,".03") ; Set for categories
  1.  D BMES^XPDUTL("  Migrating data in File #125.1 to File #125...")
  1.  D LSTMGRTN(.GMPLTXT)
  1.  D BMES^XPDUTL(.GMPLTXT)
  1.  D BMES^XPDUTL("  Migrating data in File #125.12 to File #125.11...")
  1.  D CATMGRTN(.GMPLTXTC)
  1.  D BMES^XPDUTL(.GMPLTXTC)
  1.  Q
  1.  ;
  1. BLDERMSG(GMPLTXT,GMPLLKND,GMPLERND,GMPLFILE) ; Build migration error messages
  1.  N GMPI,GMPJ,GMPK,GMPCNT,GMPX S (GMPI,GMPK)="",GMPJ=1
  1.  S GMPLTXT(1)="  The following error(s) occurred during migration to File #"_GMPLFILE_":"
  1.  F  S GMPI=$O(^TMP(GMPLLKND,$J,GMPI)) Q:'GMPI  D
  1.  . S GMPJ=GMPJ+1
  1.  . S GMPLTXT(GMPJ)=$G(^TMP(GMPLLKND,$J,GMPI))
  1.  S GMPCNT=GMPJ
  1.  F  S GMPK=$O(^TMP(GMPLERND,$J,GMPK)) Q:'GMPK  D
  1.  . S GMPCNT=GMPCNT+1,GMPX=^TMP(GMPLERND,$J,GMPK)
  1.  . S GMPLTXT(GMPCNT)="  Record #"_$P(GMPX,U)_"; Error: "_$P(GMPX,U,2)
  1.  K ^TMP(GMPLLKND,$J),^TMP(GMPLERND,$J)
  1.  Q
  1.  ;
  1. CATMGRTN(GMPLTXTC) ; Migrate data in file #125.12 to file #125.11
  1.  N GMPLIEN,GMPLDA,GMPL0,GMPFDA,GMPERR,GMPI,GMPCNT,GMPLLKND,GMPLERND,GMPLFILE
  1.  S (GMPLIEN,GMPLDA)="",(GMPCNT,GMPI)=0,GMPLFILE="125.11"
  1.  K ^TMP("GMPERRCT",$J),^TMP("GMPLKERC",$J)
  1.  F  S GMPLIEN=$O(^GMPL(125.12,"B",GMPLIEN)) Q:'GMPLIEN  D
  1.  . F  S GMPLDA=$O(^GMPL(125.12,"B",GMPLIEN,GMPLDA)) Q:'GMPLDA  D
  1.  . . L +^GMPL(125.11,GMPLIEN):5 I '$T D  Q
  1.  . . . S GMPI=GMPI+1
  1.  . . . S ^TMP("GMPLKERC",$J,GMPI)="   Lock Error: error updating record #"_GMPLIEN_" in File #125.11."
  1.  . . S GMPCNT=GMPCNT+1,GMPL0=$G(^GMPL(125.12,GMPLDA,0))
  1.  . . S GMPFDA(125.111,"+2,"_GMPLIEN_",",.01)=$P(GMPL0,U,3)
  1.  . . S GMPFDA(125.111,"+2,"_GMPLIEN_",",.02)=$P(GMPL0,U,2)
  1.  . . S GMPFDA(125.111,"+2,"_GMPLIEN_",",.03)=$P(GMPL0,U,4)
  1.  . . S GMPFDA(125.111,"+2,"_GMPLIEN_",",.04)=$P(GMPL0,U,5)
  1.  . . S GMPFDA(125.111,"+2,"_GMPLIEN_",",.05)=$P(GMPL0,U,6)
  1.  . . S GMPFDA(125.111,"+2,"_GMPLIEN_",",.06)=$P(GMPL0,U,7)
  1.  . . D UPDATE^DIE("","GMPFDA","","GMPERR")
  1.  . . L -^GMPL(125.11,GMPLIEN)
  1.  . . I $D(GMPERR) S ^TMP("GMPERRCT",$J,GMPCNT)=$G(GMPLIEN)_$G(GMPERR("DIERR",1,"TEXT",1))
  1.  S GMPLLKND="GMPLKERC",GMPLERND="GMPERRCT"
  1.  I '$D(^GMPL(125.12,"B")) S GMPLTXTC="  ...No data to migrate."
  1.  E  I $D(^TMP("GMPERRCT",$J))!($D(^TMP("GMPLKERC",$J))) D BLDERMSG(.GMPLTXTC,GMPLLKND,GMPLERND,GMPLFILE)
  1.  E  S GMPLTXTC="  ...Migration complete."
  1.  Q
  1.  ;
  1. LSTMGRTN(GMPLTXT) ; Migrate data in file #125.1 to file #125
  1.  N GMPLIEN,GMPLDA,GMPL0,GMPFDA,GMPERR,GMPCNT,GMPI,GMPLLKND,GMPLERND,GMPLFILE
  1.  S (GMPLIEN,GMPLDA)="",(GMPCNT,GMPI)=0,GMPLFILE="125"
  1.  K ^TMP("GMPERRLT",$J),^TMP("GMPLKERL",$J)
  1.  F  S GMPLIEN=$O(^GMPL(125.1,"B",GMPLIEN)) Q:'GMPLIEN  D
  1.  . F  S GMPLDA=$O(^GMPL(125.1,"B",GMPLIEN,GMPLDA)) Q:'GMPLDA  D
  1.  . . L +^GMPL(125,GMPLIEN):5 I '$T D  Q
  1.  . . . S GMPI=GMPI+1
  1.  . . . S ^TMP("GMPLKERL",$J,GMPI)="   Lock Error: error updating record #"_GMPLIEN_" in File #125."
  1.  . . S GMPCNT=GMPCNT+1,GMPL0=$G(^GMPL(125.1,GMPLDA,0))
  1.  . . S GMPFDA(125.01,"+2,"_GMPLIEN_",",.01)=$P(GMPL0,U,3)
  1.  . . S GMPFDA(125.01,"+2,"_GMPLIEN_",",.02)=$P(GMPL0,U,2)
  1.  . . S GMPFDA(125.01,"+2,"_GMPLIEN_",",.03)=$P(GMPL0,U,4)
  1.  . . S GMPFDA(125.01,"+2,"_GMPLIEN_",",.04)=$P(GMPL0,U,5)
  1.  . . D UPDATE^DIE("","GMPFDA","","GMPERR")
  1.  . . L -^GMPL(125,GMPLIEN)
  1.  . . I $D(GMPERR) S ^TMP("GMPERRLT",$J,GMPCNT)=$G(GMPLIEN)_$G(GMPERR("DIERR",1,"TEXT",1))
  1.  S GMPLLKND="GMPLKERL",GMPLERND="GMPERRLT"
  1.  I '$D(^GMPL(125.1,"B")) S GMPLTXT="  ...No data to migrate."
  1.  E  I $D(^TMP("GMPERRLT",$J))!($D(^TMP("GMPLKERL",$J))) D BLDERMSG(.GMPLTXT,GMPLLKND,GMPLERND,GMPLFILE)
  1.  E  S GMPLTXT="  ...Migration complete."
  1.  Q
  1.  ;
  1. SETCLASS(GMPLFNMB,GMPLPCE,GMPLCFLD) ; Set pre-existing lists and categories to LOCAL class
  1.  N GMPLNM,GMPLIEN,GMPL0,GMPLFDA,GMPLERR,GMPLTXT,GMPLITEM
  1.  S GMPLNM="",GMPLIEN=0
  1.  S GMPLITEM=$S(GMPLFNMB="125":"lists",1:"categories")
  1.  D BMES^XPDUTL("  Setting pre-existing "_GMPLITEM_" to a default LOCAL class...")
  1.  F  S GMPLNM=$O(^GMPL(GMPLFNMB,"B",GMPLNM)) Q:GMPLNM=""  D
  1.  . F  S GMPLIEN=$O(^GMPL(GMPLFNMB,"B",GMPLNM,GMPLIEN)) Q:'GMPLIEN  D
  1.  . . S GMPL0=$G(^GMPL(GMPLFNMB,GMPLIEN,0))
  1.  . . I '$L($P(GMPL0,U,GMPLPCE)) D
  1.  . . . S GMPLFDA(GMPLFNMB,""_GMPLIEN_",",.02)=$$DT^XLFDT
  1.  . . . S GMPLFDA(GMPLFNMB,""_GMPLIEN_",",GMPLCFLD)="L"
  1.  . . . D FILE^DIE("K","GMPLFDA","GMPLERR")
  1.  . . . I $D(GMPLERR) D
  1.  . . . . S GMPLTXT="  Record #"_GMPLIEN_"; Error: "_GMPLERR("DIERR",1,"TEXT",1)
  1.  . . . . D BMES^XPDUTL(.GMPLTXT)
  1.  D BMES^XPDUTL("  ...Local class assignments completed.")
  1.  Q
  1.  ;