EAS1092P.m

EAS1092P ;ALB/LBD - Patch Post-Install functions ; 9/26/11 4:18pm

 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**92**;15-MAR-01;Build 20

 Q

 ;

 ;Update fields in 1010EZ MAPPING file #711

 ;

EN ;Post Install entry point

 ; Update fields in 1010EZ MAPPING file #711

 D UPD711

 Q

 ;

UPD711 ;Update fields in the 1010EZ MAPPING file #711

 ;For the records related to the Last Service Episode, change the

 ;data dictionary locations in the fields MAP-TO SUB-FILE (#3) and

 ;MAP-TO FIELD (#4) to the new Military Service Episode sub-file

 ;#2.3216

 N RECNAM,FLD,NUM,LINE,IEN,DATA,ERROR,STOP

 D BMES^XPDUTL("Updating records in 1010EZ MAPPING file #711")

 F NUM=1:1 S LINE=$T(REC711+NUM) Q:LINE=""!($P(LINE,";",3)="END")  D  Q:$G(STOP)

 .S RECNAM=$P(LINE,";",3),FLD=$P(LINE,";",4)

 .S IEN=$O(^EAS(711,"B",RECNAM,"")) I 'IEN D ERR711(RECNAM) Q

 .S DATA(3)=2.3216,DATA(4)=FLD

 .D UPD^DGENDBS(711,IEN,.DATA,.ERROR) I $G(ERROR)]"" D ERR711(RECNAM) Q

 .D MES^XPDUTL("  "_RECNAM_"  -- Updated")

 Q

 ;

ERR711(RECNAM) ;Display error message and set STOP=1

 ;

 N ARR

 S STOP=1

 S ARR(1)="===================================================="

 S ARR(2)="=                   ERROR                          ="

 S ARR(3)="===================================================="

 S ARR(4)="Unable to update record "_RECNAM

 S ARR(5)="===================================================="

 ;

 D BMES^XPDUTL(.ARR)

 ;

 Q

REC711 ;;RECORD NAME;NEW FIELD NUMBER

 ;;LAST BRANCH OF SERVICE;.03

 ;;LAST ENTRY DATE;.01

 ;;LAST DISCHARGE DATE;.02

 ;;LAST DISCHARGE TYPE;.06

 ;;SERVICE NUMBER;.05

 ;;END

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---EAS1092P   1607     printed  Apr 09, 2024@20:58:56                                                                                                                                                                                                    Page 2

EAS1092P  ;ALB/LBD - Patch Post-Install functions ; 9/26/11 4:18pm

 +1       ;;1.0;ENROLLMENT APPLICATION SYSTEM;**92**;15-MAR-01;Build 20

 +2        QUIT 

 +3       ;

 +4       ;Update fields in 1010EZ MAPPING file #711

 +5       ;

EN        ;Post Install entry point

 +1       ; Update fields in 1010EZ MAPPING file #711

 +2        DO UPD711

 +3        QUIT 

 +4       ;

UPD711    ;Update fields in the 1010EZ MAPPING file #711

 +1       ;For the records related to the Last Service Episode, change the

 +2       ;data dictionary locations in the fields MAP-TO SUB-FILE (#3) and

 +3       ;MAP-TO FIELD (#4) to the new Military Service Episode sub-file

 +4       ;#2.3216

 +5        NEW RECNAM,FLD,NUM,LINE,IEN,DATA,ERROR,STOP

 +6        DO BMES^XPDUTL("Updating records in 1010EZ MAPPING file #711")

 +7        FOR NUM=1:1

               SET LINE=$TEXT(REC711+NUM)

               if LINE=""!($PIECE(LINE,";",3)="END")

                   QUIT 

               Begin DoDot:1

 +8                SET RECNAM=$PIECE(LINE,";",3)

                   SET FLD=$PIECE(LINE,";",4)

 +9                SET IEN=$ORDER(^EAS(711,"B",RECNAM,""))

                   IF 'IEN

                       DO ERR711(RECNAM)

                       QUIT 

 +10               SET DATA(3)=2.3216

                   SET DATA(4)=FLD

 +11               DO UPD^DGENDBS(711,IEN,.DATA,.ERROR)

                   IF $GET(ERROR)]""

                       DO ERR711(RECNAM)

                       QUIT 

 +12               DO MES^XPDUTL("  "_RECNAM_"  -- Updated")

               End DoDot:1

               if $GET(STOP)

                   QUIT 

 +13       QUIT 

 +14      ;

ERR711(RECNAM) ;Display error message and set STOP=1

 +1       ;

 +2        NEW ARR

 +3        SET STOP=1

 +4        SET ARR(1)="===================================================="

 +5        SET ARR(2)="=                   ERROR                          ="

 +6        SET ARR(3)="===================================================="

 +7        SET ARR(4)="Unable to update record "_RECNAM

 +8        SET ARR(5)="===================================================="

 +9       ;

 +10       DO BMES^XPDUTL(.ARR)

 +11      ;

 +12       QUIT 

REC711    ;;RECORD NAME;NEW FIELD NUMBER

 +1       ;;LAST BRANCH OF SERVICE;.03

 +2       ;;LAST ENTRY DATE;.01

 +3       ;;LAST DISCHARGE DATE;.02

 +4       ;;LAST DISCHARGE TYPE;.06

 +5       ;;SERVICE NUMBER;.05

 +6       ;;END