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 Dec 13, 2024@01:52:58 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
