PRS4P149 ;ALB/DBE - ANNUITANT INDICATOR (#454.0126) SUB FILE UPDATE ;10/11/16
;;4.0;PAID;**149**;Sep 21, 1995;Build 4
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
POST ;post install entry point
;
D BMES^XPDUTL(">>>Adding new entries to the ANNUITANT INDICATOR (#454.0126) sub file")
;
N X,Y,DA,DIC,PRSCNT,PRSREC,PRSCODE,PRSDESC
F PRSCNT=1:1 S PRSREC=$P($T(CODES+PRSCNT),";;",2) Q:PRSREC="QUIT" D
.S PRSCODE=$P(PRSREC,"^"),PRSDESC=$P(PRSREC,"^",2)
.S DIC="^PRSP(454,1,""ANN"",",DA(1)=1,DIC(0)="L",X=PRSCODE
.S DIC("DR")="1///"_PRSDESC
.D FILE^DICN
.I Y=-1 D Q
..D BMES^XPDUTL("*** Error adding entry "_PRSCODE_". ***")
..D MES^XPDUTL("*** Please contact support for assistance. ***")
.E D Q
..D BMES^XPDUTL(" Annuitant Indicator "_PRSCODE_" successfully added to the file")
;
D BMES^XPDUTL("...update complete<<<")
Q
CODES ;FORMAT
;;W^FORMER CSRS PHASED RETIREE
;;M^FORMER FERS PHASED RETIREE
;;N^FERS PHASED RETIREE AND A RETIRED UNIFORM OFFICER
;;X^CSRS PHASED RETIREE AND A RETIRED UNIFORM OFFICER
;;P^FERS PHASED RETIREE AND A RETIRED UNIFORM ENLISTED
;;Y^CSRS PHASED RETIREE AND A RETIRED UNIFORM ENLISTED
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS4P149 1218 printed Nov 22, 2024@17:32:43 Page 2
PRS4P149 ;ALB/DBE - ANNUITANT INDICATOR (#454.0126) SUB FILE UPDATE ;10/11/16
+1 ;;4.0;PAID;**149**;Sep 21, 1995;Build 4
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
POST ;post install entry point
+1 ;
+2 DO BMES^XPDUTL(">>>Adding new entries to the ANNUITANT INDICATOR (#454.0126) sub file")
+3 ;
+4 NEW X,Y,DA,DIC,PRSCNT,PRSREC,PRSCODE,PRSDESC
+5 FOR PRSCNT=1:1
SET PRSREC=$PIECE($TEXT(CODES+PRSCNT),";;",2)
if PRSREC="QUIT"
QUIT
Begin DoDot:1
+6 SET PRSCODE=$PIECE(PRSREC,"^")
SET PRSDESC=$PIECE(PRSREC,"^",2)
+7 SET DIC="^PRSP(454,1,""ANN"","
SET DA(1)=1
SET DIC(0)="L"
SET X=PRSCODE
+8 SET DIC("DR")="1///"_PRSDESC
+9 DO FILE^DICN
+10 IF Y=-1
Begin DoDot:2
+11 DO BMES^XPDUTL("*** Error adding entry "_PRSCODE_". ***")
+12 DO MES^XPDUTL("*** Please contact support for assistance. ***")
End DoDot:2
QUIT
+13 IF '$TEST
Begin DoDot:2
+14 DO BMES^XPDUTL(" Annuitant Indicator "_PRSCODE_" successfully added to the file")
End DoDot:2
QUIT
End DoDot:1
+15 ;
+16 DO BMES^XPDUTL("...update complete<<<")
+17 QUIT
CODES ;FORMAT
+1 ;;W^FORMER CSRS PHASED RETIREE
+2 ;;M^FORMER FERS PHASED RETIREE
+3 ;;N^FERS PHASED RETIREE AND A RETIRED UNIFORM OFFICER
+4 ;;X^CSRS PHASED RETIREE AND A RETIRED UNIFORM OFFICER
+5 ;;P^FERS PHASED RETIREE AND A RETIRED UNIFORM ENLISTED
+6 ;;Y^CSRS PHASED RETIREE AND A RETIRED UNIFORM ENLISTED
+7 ;;QUIT
