GMPLY49A ;ISP/TC - Problem Selection List Files Data Migration ;08/22/17 11:32
;;2.0;Problem List;**49**;Aug 25, 1994;Build 43
;
; External References:
; ICR 2053 FILE/UPDATE^DIE
; ICR 10103 $$DT^XLFDT
; ICR 10141 MES/BMES^XPDUTL
;
EN ;
N GMPLTXT,GMPLTXTC
D SETCLASS("125",4,".04") ; Set for selection lists
D SETCLASS("125.11",3,".03") ; Set for categories
D BMES^XPDUTL(" Migrating data in File #125.1 to File #125...")
D LSTMGRTN(.GMPLTXT)
D BMES^XPDUTL(.GMPLTXT)
D BMES^XPDUTL(" Migrating data in File #125.12 to File #125.11...")
D CATMGRTN(.GMPLTXTC)
D BMES^XPDUTL(.GMPLTXTC)
Q
;
BLDERMSG(GMPLTXT,GMPLLKND,GMPLERND,GMPLFILE) ; Build migration error messages
N GMPI,GMPJ,GMPK,GMPCNT,GMPX S (GMPI,GMPK)="",GMPJ=1
S GMPLTXT(1)=" The following error(s) occurred during migration to File #"_GMPLFILE_":"
F S GMPI=$O(^TMP(GMPLLKND,$J,GMPI)) Q:'GMPI D
. S GMPJ=GMPJ+1
. S GMPLTXT(GMPJ)=$G(^TMP(GMPLLKND,$J,GMPI))
S GMPCNT=GMPJ
F S GMPK=$O(^TMP(GMPLERND,$J,GMPK)) Q:'GMPK D
. S GMPCNT=GMPCNT+1,GMPX=^TMP(GMPLERND,$J,GMPK)
. S GMPLTXT(GMPCNT)=" Record #"_$P(GMPX,U)_"; Error: "_$P(GMPX,U,2)
K ^TMP(GMPLLKND,$J),^TMP(GMPLERND,$J)
Q
;
CATMGRTN(GMPLTXTC) ; Migrate data in file #125.12 to file #125.11
N GMPLIEN,GMPLDA,GMPL0,GMPFDA,GMPERR,GMPI,GMPCNT,GMPLLKND,GMPLERND,GMPLFILE
S (GMPLIEN,GMPLDA)="",(GMPCNT,GMPI)=0,GMPLFILE="125.11"
K ^TMP("GMPERRCT",$J),^TMP("GMPLKERC",$J)
F S GMPLIEN=$O(^GMPL(125.12,"B",GMPLIEN)) Q:'GMPLIEN D
. F S GMPLDA=$O(^GMPL(125.12,"B",GMPLIEN,GMPLDA)) Q:'GMPLDA D
. . L +^GMPL(125.11,GMPLIEN):5 I '$T D Q
. . . S GMPI=GMPI+1
. . . S ^TMP("GMPLKERC",$J,GMPI)=" Lock Error: error updating record #"_GMPLIEN_" in File #125.11."
. . S GMPCNT=GMPCNT+1,GMPL0=$G(^GMPL(125.12,GMPLDA,0))
. . S GMPFDA(125.111,"+2,"_GMPLIEN_",",.01)=$P(GMPL0,U,3)
. . S GMPFDA(125.111,"+2,"_GMPLIEN_",",.02)=$P(GMPL0,U,2)
. . S GMPFDA(125.111,"+2,"_GMPLIEN_",",.03)=$P(GMPL0,U,4)
. . S GMPFDA(125.111,"+2,"_GMPLIEN_",",.04)=$P(GMPL0,U,5)
. . S GMPFDA(125.111,"+2,"_GMPLIEN_",",.05)=$P(GMPL0,U,6)
. . S GMPFDA(125.111,"+2,"_GMPLIEN_",",.06)=$P(GMPL0,U,7)
. . D UPDATE^DIE("","GMPFDA","","GMPERR")
. . L -^GMPL(125.11,GMPLIEN)
. . I $D(GMPERR) S ^TMP("GMPERRCT",$J,GMPCNT)=$G(GMPLIEN)_$G(GMPERR("DIERR",1,"TEXT",1))
S GMPLLKND="GMPLKERC",GMPLERND="GMPERRCT"
I '$D(^GMPL(125.12,"B")) S GMPLTXTC=" ...No data to migrate."
E I $D(^TMP("GMPERRCT",$J))!($D(^TMP("GMPLKERC",$J))) D BLDERMSG(.GMPLTXTC,GMPLLKND,GMPLERND,GMPLFILE)
E S GMPLTXTC=" ...Migration complete."
Q
;
LSTMGRTN(GMPLTXT) ; Migrate data in file #125.1 to file #125
N GMPLIEN,GMPLDA,GMPL0,GMPFDA,GMPERR,GMPCNT,GMPI,GMPLLKND,GMPLERND,GMPLFILE
S (GMPLIEN,GMPLDA)="",(GMPCNT,GMPI)=0,GMPLFILE="125"
K ^TMP("GMPERRLT",$J),^TMP("GMPLKERL",$J)
F S GMPLIEN=$O(^GMPL(125.1,"B",GMPLIEN)) Q:'GMPLIEN D
. F S GMPLDA=$O(^GMPL(125.1,"B",GMPLIEN,GMPLDA)) Q:'GMPLDA D
. . L +^GMPL(125,GMPLIEN):5 I '$T D Q
. . . S GMPI=GMPI+1
. . . S ^TMP("GMPLKERL",$J,GMPI)=" Lock Error: error updating record #"_GMPLIEN_" in File #125."
. . S GMPCNT=GMPCNT+1,GMPL0=$G(^GMPL(125.1,GMPLDA,0))
. . S GMPFDA(125.01,"+2,"_GMPLIEN_",",.01)=$P(GMPL0,U,3)
. . S GMPFDA(125.01,"+2,"_GMPLIEN_",",.02)=$P(GMPL0,U,2)
. . S GMPFDA(125.01,"+2,"_GMPLIEN_",",.03)=$P(GMPL0,U,4)
. . S GMPFDA(125.01,"+2,"_GMPLIEN_",",.04)=$P(GMPL0,U,5)
. . D UPDATE^DIE("","GMPFDA","","GMPERR")
. . L -^GMPL(125,GMPLIEN)
. . I $D(GMPERR) S ^TMP("GMPERRLT",$J,GMPCNT)=$G(GMPLIEN)_$G(GMPERR("DIERR",1,"TEXT",1))
S GMPLLKND="GMPLKERL",GMPLERND="GMPERRLT"
I '$D(^GMPL(125.1,"B")) S GMPLTXT=" ...No data to migrate."
E I $D(^TMP("GMPERRLT",$J))!($D(^TMP("GMPLKERL",$J))) D BLDERMSG(.GMPLTXT,GMPLLKND,GMPLERND,GMPLFILE)
E S GMPLTXT=" ...Migration complete."
Q
;
SETCLASS(GMPLFNMB,GMPLPCE,GMPLCFLD) ; Set pre-existing lists and categories to LOCAL class
N GMPLNM,GMPLIEN,GMPL0,GMPLFDA,GMPLERR,GMPLTXT,GMPLITEM
S GMPLNM="",GMPLIEN=0
S GMPLITEM=$S(GMPLFNMB="125":"lists",1:"categories")
D BMES^XPDUTL(" Setting pre-existing "_GMPLITEM_" to a default LOCAL class...")
F S GMPLNM=$O(^GMPL(GMPLFNMB,"B",GMPLNM)) Q:GMPLNM="" D
. F S GMPLIEN=$O(^GMPL(GMPLFNMB,"B",GMPLNM,GMPLIEN)) Q:'GMPLIEN D
. . S GMPL0=$G(^GMPL(GMPLFNMB,GMPLIEN,0))
. . I '$L($P(GMPL0,U,GMPLPCE)) D
. . . S GMPLFDA(GMPLFNMB,""_GMPLIEN_",",.02)=$$DT^XLFDT
. . . S GMPLFDA(GMPLFNMB,""_GMPLIEN_",",GMPLCFLD)="L"
. . . D FILE^DIE("K","GMPLFDA","GMPLERR")
. . . I $D(GMPLERR) D
. . . . S GMPLTXT=" Record #"_GMPLIEN_"; Error: "_GMPLERR("DIERR",1,"TEXT",1)
. . . . D BMES^XPDUTL(.GMPLTXT)
D BMES^XPDUTL(" ...Local class assignments completed.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLY49A 4734 printed Nov 22, 2024@17:40:40 Page 2
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
+2 ;
+3 ; External References:
+4 ; ICR 2053 FILE/UPDATE^DIE
+5 ; ICR 10103 $$DT^XLFDT
+6 ; ICR 10141 MES/BMES^XPDUTL
+7 ;
EN ;
+1 NEW GMPLTXT,GMPLTXTC
+2 ; Set for selection lists
DO SETCLASS("125",4,".04")
+3 ; Set for categories
DO SETCLASS("125.11",3,".03")
+4 DO BMES^XPDUTL(" Migrating data in File #125.1 to File #125...")
+5 DO LSTMGRTN(.GMPLTXT)
+6 DO BMES^XPDUTL(.GMPLTXT)
+7 DO BMES^XPDUTL(" Migrating data in File #125.12 to File #125.11...")
+8 DO CATMGRTN(.GMPLTXTC)
+9 DO BMES^XPDUTL(.GMPLTXTC)
+10 QUIT
+11 ;
BLDERMSG(GMPLTXT,GMPLLKND,GMPLERND,GMPLFILE) ; Build migration error messages
+1 NEW GMPI,GMPJ,GMPK,GMPCNT,GMPX
SET (GMPI,GMPK)=""
SET GMPJ=1
+2 SET GMPLTXT(1)=" The following error(s) occurred during migration to File #"_GMPLFILE_":"
+3 FOR
SET GMPI=$ORDER(^TMP(GMPLLKND,$JOB,GMPI))
if 'GMPI
QUIT
Begin DoDot:1
+4 SET GMPJ=GMPJ+1
+5 SET GMPLTXT(GMPJ)=$GET(^TMP(GMPLLKND,$JOB,GMPI))
End DoDot:1
+6 SET GMPCNT=GMPJ
+7 FOR
SET GMPK=$ORDER(^TMP(GMPLERND,$JOB,GMPK))
if 'GMPK
QUIT
Begin DoDot:1
+8 SET GMPCNT=GMPCNT+1
SET GMPX=^TMP(GMPLERND,$JOB,GMPK)
+9 SET GMPLTXT(GMPCNT)=" Record #"_$PIECE(GMPX,U)_"; Error: "_$PIECE(GMPX,U,2)
End DoDot:1
+10 KILL ^TMP(GMPLLKND,$JOB),^TMP(GMPLERND,$JOB)
+11 QUIT
+12 ;
CATMGRTN(GMPLTXTC) ; Migrate data in file #125.12 to file #125.11
+1 NEW GMPLIEN,GMPLDA,GMPL0,GMPFDA,GMPERR,GMPI,GMPCNT,GMPLLKND,GMPLERND,GMPLFILE
+2 SET (GMPLIEN,GMPLDA)=""
SET (GMPCNT,GMPI)=0
SET GMPLFILE="125.11"
+3 KILL ^TMP("GMPERRCT",$JOB),^TMP("GMPLKERC",$JOB)
+4 FOR
SET GMPLIEN=$ORDER(^GMPL(125.12,"B",GMPLIEN))
if 'GMPLIEN
QUIT
Begin DoDot:1
+5 FOR
SET GMPLDA=$ORDER(^GMPL(125.12,"B",GMPLIEN,GMPLDA))
if 'GMPLDA
QUIT
Begin DoDot:2
+6 LOCK +^GMPL(125.11,GMPLIEN):5
IF '$TEST
Begin DoDot:3
+7 SET GMPI=GMPI+1
+8 SET ^TMP("GMPLKERC",$JOB,GMPI)=" Lock Error: error updating record #"_GMPLIEN_" in File #125.11."
End DoDot:3
QUIT
+9 SET GMPCNT=GMPCNT+1
SET GMPL0=$GET(^GMPL(125.12,GMPLDA,0))
+10 SET GMPFDA(125.111,"+2,"_GMPLIEN_",",.01)=$PIECE(GMPL0,U,3)
+11 SET GMPFDA(125.111,"+2,"_GMPLIEN_",",.02)=$PIECE(GMPL0,U,2)
+12 SET GMPFDA(125.111,"+2,"_GMPLIEN_",",.03)=$PIECE(GMPL0,U,4)
+13 SET GMPFDA(125.111,"+2,"_GMPLIEN_",",.04)=$PIECE(GMPL0,U,5)
+14 SET GMPFDA(125.111,"+2,"_GMPLIEN_",",.05)=$PIECE(GMPL0,U,6)
+15 SET GMPFDA(125.111,"+2,"_GMPLIEN_",",.06)=$PIECE(GMPL0,U,7)
+16 DO UPDATE^DIE("","GMPFDA","","GMPERR")
+17 LOCK -^GMPL(125.11,GMPLIEN)
+18 IF $DATA(GMPERR)
SET ^TMP("GMPERRCT",$JOB,GMPCNT)=$GET(GMPLIEN)_$GET(GMPERR("DIERR",1,"TEXT",1))
End DoDot:2
End DoDot:1
+19 SET GMPLLKND="GMPLKERC"
SET GMPLERND="GMPERRCT"
+20 IF '$DATA(^GMPL(125.12,"B"))
SET GMPLTXTC=" ...No data to migrate."
+21 IF '$TEST
IF $DATA(^TMP("GMPERRCT",$JOB))!($DATA(^TMP("GMPLKERC",$JOB)))
DO BLDERMSG(.GMPLTXTC,GMPLLKND,GMPLERND,GMPLFILE)
+22 IF '$TEST
SET GMPLTXTC=" ...Migration complete."
+23 QUIT
+24 ;
LSTMGRTN(GMPLTXT) ; Migrate data in file #125.1 to file #125
+1 NEW GMPLIEN,GMPLDA,GMPL0,GMPFDA,GMPERR,GMPCNT,GMPI,GMPLLKND,GMPLERND,GMPLFILE
+2 SET (GMPLIEN,GMPLDA)=""
SET (GMPCNT,GMPI)=0
SET GMPLFILE="125"
+3 KILL ^TMP("GMPERRLT",$JOB),^TMP("GMPLKERL",$JOB)
+4 FOR
SET GMPLIEN=$ORDER(^GMPL(125.1,"B",GMPLIEN))
if 'GMPLIEN
QUIT
Begin DoDot:1
+5 FOR
SET GMPLDA=$ORDER(^GMPL(125.1,"B",GMPLIEN,GMPLDA))
if 'GMPLDA
QUIT
Begin DoDot:2
+6 LOCK +^GMPL(125,GMPLIEN):5
IF '$TEST
Begin DoDot:3
+7 SET GMPI=GMPI+1
+8 SET ^TMP("GMPLKERL",$JOB,GMPI)=" Lock Error: error updating record #"_GMPLIEN_" in File #125."
End DoDot:3
QUIT
+9 SET GMPCNT=GMPCNT+1
SET GMPL0=$GET(^GMPL(125.1,GMPLDA,0))
+10 SET GMPFDA(125.01,"+2,"_GMPLIEN_",",.01)=$PIECE(GMPL0,U,3)
+11 SET GMPFDA(125.01,"+2,"_GMPLIEN_",",.02)=$PIECE(GMPL0,U,2)
+12 SET GMPFDA(125.01,"+2,"_GMPLIEN_",",.03)=$PIECE(GMPL0,U,4)
+13 SET GMPFDA(125.01,"+2,"_GMPLIEN_",",.04)=$PIECE(GMPL0,U,5)
+14 DO UPDATE^DIE("","GMPFDA","","GMPERR")
+15 LOCK -^GMPL(125,GMPLIEN)
+16 IF $DATA(GMPERR)
SET ^TMP("GMPERRLT",$JOB,GMPCNT)=$GET(GMPLIEN)_$GET(GMPERR("DIERR",1,"TEXT",1))
End DoDot:2
End DoDot:1
+17 SET GMPLLKND="GMPLKERL"
SET GMPLERND="GMPERRLT"
+18 IF '$DATA(^GMPL(125.1,"B"))
SET GMPLTXT=" ...No data to migrate."
+19 IF '$TEST
IF $DATA(^TMP("GMPERRLT",$JOB))!($DATA(^TMP("GMPLKERL",$JOB)))
DO BLDERMSG(.GMPLTXT,GMPLLKND,GMPLERND,GMPLFILE)
+20 IF '$TEST
SET GMPLTXT=" ...Migration complete."
+21 QUIT
+22 ;
SETCLASS(GMPLFNMB,GMPLPCE,GMPLCFLD) ; Set pre-existing lists and categories to LOCAL class
+1 NEW GMPLNM,GMPLIEN,GMPL0,GMPLFDA,GMPLERR,GMPLTXT,GMPLITEM
+2 SET GMPLNM=""
SET GMPLIEN=0
+3 SET GMPLITEM=$SELECT(GMPLFNMB="125":"lists",1:"categories")
+4 DO BMES^XPDUTL(" Setting pre-existing "_GMPLITEM_" to a default LOCAL class...")
+5 FOR
SET GMPLNM=$ORDER(^GMPL(GMPLFNMB,"B",GMPLNM))
if GMPLNM=""
QUIT
Begin DoDot:1
+6 FOR
SET GMPLIEN=$ORDER(^GMPL(GMPLFNMB,"B",GMPLNM,GMPLIEN))
if 'GMPLIEN
QUIT
Begin DoDot:2
+7 SET GMPL0=$GET(^GMPL(GMPLFNMB,GMPLIEN,0))
+8 IF '$LENGTH($PIECE(GMPL0,U,GMPLPCE))
Begin DoDot:3
+9 SET GMPLFDA(GMPLFNMB,""_GMPLIEN_",",.02)=$$DT^XLFDT
+10 SET GMPLFDA(GMPLFNMB,""_GMPLIEN_",",GMPLCFLD)="L"
+11 DO FILE^DIE("K","GMPLFDA","GMPLERR")
+12 IF $DATA(GMPLERR)
Begin DoDot:4
+13 SET GMPLTXT=" Record #"_GMPLIEN_"; Error: "_GMPLERR("DIERR",1,"TEXT",1)
+14 DO BMES^XPDUTL(.GMPLTXT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 DO BMES^XPDUTL(" ...Local class assignments completed.")
+16 QUIT
+17 ;
