PRS4P149.m

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 ---PRS4P149   1218     printed  Apr 09, 2024@21:30:33                                                                                                                                                                                                    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