- 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 ---[H[J[2J[HEAS1092P 1607 printed Mar 13, 2025@20:57:39 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
