DG53754C.m

DG53754C ;ALB/TDM - Patch DG*5.3*754 Install Utility Routine ; 7/6/10 3:55pm

 ;;5.3;Registration;**754**;AUG 13, 1993;Build 46

 Q

 ;

EP ; Continuation of DG53754P post install routine.

 F I=1:1 S ELEMNT=$P($T(TEXT+I),";;",2) Q:ELEMNT="QUIT"!(ABORT)  D

 . S EXIST=0

 . K DGDATA S (DATA,SUB)="" F J=1:1:$L(ELEMNT,";") S DATA=$P(ELEMNT,";",J) D  Q:EXIST

 . . S SUB=$P(DATA,"~",1),VALUE=$P(DATA,"~",2),DGDATA(SUB)=VALUE

 . . I SUB=.01 S EXIST=$$FIND1^DIC(FILE,,,DGDATA(.01))

 . I 'EXIST D

 . . S FILEFLG=$$ADD^DGENDBS(FILE,,.DGDATA)

 . . I FILEFLG D MES^XPDUTL("Added - "_$G(DGDATA(.01)))

 . . I 'FILEFLG D

 . . . S ABORT=1,XPDABORT=2

 . . . D BMES^XPDUTL("Install process could not add an entry in file for "_$G(DGDATA(.01)))

 . . . D BMES^XPDUTL("                        <<<< INSTALLATION ABORTED >>>>")

 Q

 ;

TEXT ;;FIELD#~VALUE;FIELD#~VALUE;FIELD#~VALUE.....

 ;;.01~SPOUSE'S EMPLOYMENT STATUS;.02~ZEM03S;.03~1;.04~2;.05~.2515;.06~1;.08~0;10~S DR=.2515 D LOOK^IVMPREC9;20~S DR=.2515,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~SPOUSE'S EMPLOYER NAME;.02~ZEM04S;.03~1;.04~2;.05~.251;.08~0;10~S DR=.251 D LOOK^IVMPREC9;20~S DR=.251 D LOOK^IVMPREC9

 ;;.01~SPOUSE'S OCCUPATION;.02~ZEM05S;.03~1;.04~2;.05~.2514;.08~0;10~S DR=.2514 D LOOK^IVMPREC9;20~S DR=.2514 D LOOK^IVMPREC9

 ;;.01~SPOUSE'S EMPLOYER ADDR LINE 1;.02~ZEM061S;.03~1;.04~2;.05~.252;.08~0;10~S DR=.252 D LOOK^IVMPREC9;20~S DR=.252 D LOOK^IVMPREC9

 ;;.01~SPOUSE'S EMPLOYER ADDR LINE 2;.02~ZEM062S;.03~1;.04~2;.05~.253;.08~0;10~S DR=.253 D LOOK^IVMPREC9;20~S DR=.253 D LOOK^IVMPREC9

 ;;.01~SPOUSE'S EMPLOYER ADDR LINE 3;.02~ZEM068S;.03~1;.04~2;.05~.254;.08~0;10~S DR=.254 D LOOK^IVMPREC9;20~S DR=.254 D LOOK^IVMPREC9

 ;;.01~SPOUSE'S EMPLOYER CITY;.02~ZEM063S;.03~1;.04~2;.05~.255;.08~0;10~S DR=.255 D LOOK^IVMPREC9;20~S DR=.255 D LOOK^IVMPREC9

 ;;.01~SPOUSE'S EMPLOYER STATE;.02~ZEM064S;.03~1;.04~2;.05~.256;.06~1;.08~0;10~S DR=.256 D LOOK^IVMPREC9;20~S DR=.256,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~SPOUSE'S EMPLOYER ZIP;.02~ZEM065S;.03~1;.04~2;.05~.257;.08~0;10~S DR=.257 D LOOK^IVMPREC9;20~S DR=.257 D LOOK^IVMPREC9

 ;;.01~SPOUSE'S EMPLOYER TELEPHONE;.02~ZEM07S;.03~1;.04~2;.05~.258;.08~0;10~S DR=.258 D LOOK^IVMPREC9;20~S DR=.258 D LOOK^IVMPREC9

 ;;.01~SPOUSE'S RETIREMENT DATE;.02~ZEM09S;.03~1;.04~2;.05~.2516;.06~1;.08~0;10~S DR=.2516 D LOOK^IVMPREC9;20~S DR=.2516,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~PHONE NUMBER [WORK];.02~PID13W;.03~1;.04~2;.05~.132;.08~0;10~S DR=.132 D LOOK^IVMPREC9;20~S DR=.132 D LOOK^IVMPREC9

 ;;QUIT

 ;;

 ;;The following have been disabled until further notice

 ;;.01~CONFIDENTIAL ADDR CHANGE SITE;.02~RF161CA;.03~1;.04~2;.05~.14113;.08~0;10~S DR=.14113 D LOOK^IVMPREC9;20~S DR=.14113 D LOOK^IVMPREC9

 ;;.01~CONFIDENTIAL ADDR CHANGE DT/TM;.02~RF171CA;.03~1;.04~2;.05~.14112;.08~0;10~S DR=.14112 D LOOK^IVMPREC9;20~S DR=.14112,DIQ(0)="E" D LOOK^IVMPREC9

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53754C   2861     printed  Apr 09, 2024@21:38:44                                                                                                                                                                                                    Page 2

DG53754C  ;ALB/TDM - Patch DG*5.3*754 Install Utility Routine ; 7/6/10 3:55pm

 +1       ;;5.3;Registration;**754**;AUG 13, 1993;Build 46

 +2        QUIT 

 +3       ;

EP        ; Continuation of DG53754P post install routine.

 +1        FOR I=1:1

               SET ELEMNT=$PIECE($TEXT(TEXT+I),";;",2)

               if ELEMNT="QUIT"!(ABORT)

                   QUIT 

               Begin DoDot:1

 +2                SET EXIST=0

 +3                KILL DGDATA

                   SET (DATA,SUB)=""

                   FOR J=1:1:$LENGTH(ELEMNT,";")

                       SET DATA=$PIECE(ELEMNT,";",J)

                       Begin DoDot:2

 +4                        SET SUB=$PIECE(DATA,"~",1)

                           SET VALUE=$PIECE(DATA,"~",2)

                           SET DGDATA(SUB)=VALUE

 +5                        IF SUB=.01

                               SET EXIST=$$FIND1^DIC(FILE,,,DGDATA(.01))

                       End DoDot:2

                       if EXIST

                           QUIT 

 +6                IF 'EXIST

                       Begin DoDot:2

 +7                        SET FILEFLG=$$ADD^DGENDBS(FILE,,.DGDATA)

 +8                        IF FILEFLG

                               DO MES^XPDUTL("Added - "_$GET(DGDATA(.01)))

 +9                        IF 'FILEFLG

                               Begin DoDot:3

 +10                               SET ABORT=1

                                   SET XPDABORT=2

 +11                               DO BMES^XPDUTL("Install process could not add an entry in file for "_$GET(DGDATA(.01)))

 +12                               DO BMES^XPDUTL("                        <<<< INSTALLATION ABORTED >>>>")

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +13       QUIT 

 +14      ;

TEXT      ;;FIELD#~VALUE;FIELD#~VALUE;FIELD#~VALUE.....

 +1       ;;.01~SPOUSE'S EMPLOYMENT STATUS;.02~ZEM03S;.03~1;.04~2;.05~.2515;.06~1;.08~0;10~S DR=.2515 D LOOK^IVMPREC9;20~S DR=.2515,DIQ(0)="E" D LOOK^IVMPREC9

 +2       ;;.01~SPOUSE'S EMPLOYER NAME;.02~ZEM04S;.03~1;.04~2;.05~.251;.08~0;10~S DR=.251 D LOOK^IVMPREC9;20~S DR=.251 D LOOK^IVMPREC9

 +3       ;;.01~SPOUSE'S OCCUPATION;.02~ZEM05S;.03~1;.04~2;.05~.2514;.08~0;10~S DR=.2514 D LOOK^IVMPREC9;20~S DR=.2514 D LOOK^IVMPREC9

 +4       ;;.01~SPOUSE'S EMPLOYER ADDR LINE 1;.02~ZEM061S;.03~1;.04~2;.05~.252;.08~0;10~S DR=.252 D LOOK^IVMPREC9;20~S DR=.252 D LOOK^IVMPREC9

 +5       ;;.01~SPOUSE'S EMPLOYER ADDR LINE 2;.02~ZEM062S;.03~1;.04~2;.05~.253;.08~0;10~S DR=.253 D LOOK^IVMPREC9;20~S DR=.253 D LOOK^IVMPREC9

 +6       ;;.01~SPOUSE'S EMPLOYER ADDR LINE 3;.02~ZEM068S;.03~1;.04~2;.05~.254;.08~0;10~S DR=.254 D LOOK^IVMPREC9;20~S DR=.254 D LOOK^IVMPREC9

 +7       ;;.01~SPOUSE'S EMPLOYER CITY;.02~ZEM063S;.03~1;.04~2;.05~.255;.08~0;10~S DR=.255 D LOOK^IVMPREC9;20~S DR=.255 D LOOK^IVMPREC9

 +8       ;;.01~SPOUSE'S EMPLOYER STATE;.02~ZEM064S;.03~1;.04~2;.05~.256;.06~1;.08~0;10~S DR=.256 D LOOK^IVMPREC9;20~S DR=.256,DIQ(0)="E" D LOOK^IVMPREC9

 +9       ;;.01~SPOUSE'S EMPLOYER ZIP;.02~ZEM065S;.03~1;.04~2;.05~.257;.08~0;10~S DR=.257 D LOOK^IVMPREC9;20~S DR=.257 D LOOK^IVMPREC9

 +10      ;;.01~SPOUSE'S EMPLOYER TELEPHONE;.02~ZEM07S;.03~1;.04~2;.05~.258;.08~0;10~S DR=.258 D LOOK^IVMPREC9;20~S DR=.258 D LOOK^IVMPREC9

 +11      ;;.01~SPOUSE'S RETIREMENT DATE;.02~ZEM09S;.03~1;.04~2;.05~.2516;.06~1;.08~0;10~S DR=.2516 D LOOK^IVMPREC9;20~S DR=.2516,DIQ(0)="E" D LOOK^IVMPREC9

 +12      ;;.01~PHONE NUMBER [WORK];.02~PID13W;.03~1;.04~2;.05~.132;.08~0;10~S DR=.132 D LOOK^IVMPREC9;20~S DR=.132 D LOOK^IVMPREC9

 +13      ;;QUIT

 +14      ;;

 +15      ;;The following have been disabled until further notice

 +16      ;;.01~CONFIDENTIAL ADDR CHANGE SITE;.02~RF161CA;.03~1;.04~2;.05~.14113;.08~0;10~S DR=.14113 D LOOK^IVMPREC9;20~S DR=.14113 D LOOK^IVMPREC9

 +17      ;;.01~CONFIDENTIAL ADDR CHANGE DT/TM;.02~RF171CA;.03~1;.04~2;.05~.14112;.08~0;10~S DR=.14112 D LOOK^IVMPREC9;20~S DR=.14112,DIQ(0)="E" D LOOK^IVMPREC9