PRSXP48 ;LLH/WCIOFO-POST INSTALL UPDATE TO FEGLI CODES;3/26/99
;;4.0;PAID;**48**;Sep 21, 1995
;
;4 callable entry points
; 1. UPDTFEG - delete FEGLI codes & add NEW codes. Called by
; patch PRS*4*48 post installation.
; 2. RSTRFEG - delete new FEGLI codes & restore OLD codes
; 3. DELOLD - delete all existing codes.
; 4. ADDFEG(RESTORE) ADD FEGLI codes
;
; Routine intended 2b temporary. Delete after PRS*4*48 install.
;
Q
;==============================================================
UPDTFEG ; UPDATE NEW FEGLI CODES PER VACO.
; This entry point will delete all existing FEGLI codes
; from File 454 & then add new codes & descriptions that are changed
; by VACO-directive 99-119.
;
D DELOLD,ADDFEG(0),MSSG
Q
;
;==============================================================
RSTRFEG ;RESTORE OLD FEGLI CODES
; This entry point restores the FEGLI codes to pre VACO
; directive 99-119. Coded for testing and just in case need
; to return to the old codes
;
D DELOLD,ADDFEG(1)
Q
;
;==============================================================
DELOLD ; DELETE ALL OF THE OLD FEGLI CODES
; Loop thru PAID CODE FILES "FEGLI" entry
; to delete each entry and associated cross references.
; Inner loop ensures any duplicates are deleted.
;
N DIK,REC,DA
S REC=""
F S REC=$O(^PRSP(454,1,"FEG","B",REC)) Q:REC="" D
. S DA=""
. F S DA=$O(^PRSP(454,1,"FEG","B",REC,DA)) Q:DA="" D
.. S DIK="^PRSP(454,1,""FEG"",",DA(1)=1
.. D ^DIK
Q
;
;==============================================================
ADDFEG(RESTORE) ; ADD FEGLI codes
; Input: RESTORE - Flag determines label for codes/descriptions
; Use old codes if RESTORE=1, otherwise new codes.
;
; Loop thru new codes & descriptions at label NFEG or OFEG
; & add to PAID CODE FILES, "FEG" entry.
;
N NEWCODE,CODE,TXT,DIE,DA,DIC,X,DLAYGO,DR
S RESTORE=$S($G(RESTORE)=1:RESTORE,1:0)
S (DIC,DIE)="^PRSP(454,1,""FEG"",",DA(1)=1
F I=1:1 S NEWCODE=$$PICKCODE(RESTORE,I) Q:NEWCODE="" D
. K DO,DD
. S CODE=$P(NEWCODE,";")
. S X=CODE,DIC(0)="L",DLAYGO=454 D FILE^DICN
. S DA=+Y
. S TXT=$P(NEWCODE,";",2)
. S DR="1///^S X=TXT"
. D ^DIE
Q
;==============================================================
PICKCODE(RSTOR,LINE) ;function returns text for FEGLI codes
; If RSTOR flag > 0 then get old codes otherwise get new.
Q $S(RSTOR:$P($T(OFEG+LINE),";;",2),1:$P($T(NFEG+LINE),";;",2))
;
;==============================================================
MSSG ;KIDS POST INSTALLATION MESSAGE.
D MES^XPDUTL(" Updating FEGLI codes.")
H 1
D MES^XPDUTL(" You should delete routine PRSXP48 when installation is complete.")
H 1
Q
;==============================================================
OFEG ; old FEGLI Codes and Definitions
;;A;INELIGIBLE FOR LIFE INSURANCE COVERAGE
;;B;WAIVED ALL LIFE INSURANCE
;;C;BASIC LIFE ONLY
;;D;BASIC LIFE + STANDARD OPTION
;;E;BASIC LIFE + FAMILY OPTION
;;F;BASIC LIFE + STANDARD OPTION & FAMILY OPTION
;;G;BASIC LIFE + ADDITIONAL OPTION WITH 1 X PAY
;;H;BASIC LIFE + ADDITIONAL OPTION WITH 1 X PAY & STANDARD OPTION
;;I;BASIC LIFE + ADDITIONAL OPTION WITH 1 X PAY & FAMILY OPTION
;;J;BASIC LIFE + ADDITIONAL OPTION WITH 1 X PAY & STANDARD OPTION & FAMILY OPTION
;;K;BASIC LIFE + ADDITIONAL OPTION WITH 2 X PAY
;;L;BASIC LIFE + ADDITIONAL OPTION WITH 2 X PAY & STANDARD OPTION
;;M;BASIC LIFE + ADDITIONAL OPTION WITH 2 X PAY & FAMILY OPTION
;;N;BASIC LIFE + ADDITIONAL OPTION WITH 2 X PAY & STANDARD OPTION & FAMILY OPTION
;;9;BASIC LIFE + ADDITIONAL OPTION WITH 3 X PAY
;;P;BASIC LIFE + ADDITIONAL OPTION WITH 3 X PAY & STANDARD OPTION
;;Q;BASIC LIFE + ADDITIONAL OPTION WITH 3 X PAY & FAMILY OPTION
;;R;BASIC LIFE + ADDITIONAL OPTION WITH 3 X PAY & STANDARD OPTION & FAMILY OPTION
;;S;BASIC LIFE + ADDITIONAL OPTION WITH 4 X PAY
;;T;BASIC LIFE + ADDITIONAL OPTION WITH 4 X PAY & STANDARD OPTION
;;U;BASIC LIFE + ADDITIONAL OPTION WITH 4 X PAY & FAMILY OPTION
;;V;BASIC LIFE + ADDITIONAL OPTION WITH 4 X PAY & STANDARD OPTION & FAMILY OPTION
;;W;BASIC LIFE + ADDITIONAL OPTION WITH 5 X PAY
;;X;BASIC LIFE + ADDITIONAL OPTION WITH 5 X PAY & STANDARD OPTION
;;Y;BASIC LIFE + ADDITIONAL OPTION WITH 5 X PAY & FAMILY OPTION
;;Z;BASIC LIFE + ADDITIONAL OPTION WITH 5 X PAY & STANDARD OPTION & FAMILY OPTION
;;O;BASIC LIFE + ADDITIONAL OPTION WITH 3 X PAY
;;
Q
;=============================================================
NFEG ; New FEGLI codes and Descriptions - post Patch 48
;;A0;Ineligible
;;B0;Waived
;;C0;Basic only
;;D0;Basic + Option A
;;E1;Basic + Option C (1x)
;;E2;Basic + Option C (2x)
;;E3;Basic + Option C (3x)
;;E4;Basic + Option C (4x)
;;E5;Basic + Option C (5x)
;;F1;Basic + Option A + Option C (1x)
;;F2;Basic + Option A + Option C (2x)
;;F3;Basic + Option A + Option C (3x)
;;F4;Basic + Option A + Option C (4x)
;;F5;Basic + Option A + Option C (5x)
;;G0;Basic + Option B (1x)
;;H0;Basic + Option B (1x) + Option A
;;I1;Basic + Option B (1x) + Option C (1x)
;;I2;Basic + Option B (1x) + Option C (2x)
;;I3;Basic + Option B (1x) + Option C (3x)
;;I4;Basic + Option B (1x) + Option C (4x)
;;I5;Basic + Option B (1x) + Option C (5x)
;;J1;Basic + Option B (1x) + Option A + Option C (1x)
;;J2;Basic + Option B (1x) + Option A + Option C (2x)
;;J3;Basic + Option B (1x) + Option A + Option C (3x)
;;J4;Basic + Option B (1x) + Option A + Option C (4x)
;;J5;Basic + Option B (1x) + Option A + Option C (5x)
;;K0;Basic + Option B (2x)
;;L0;Basic + Option B (2x) + Option A
;;M1;Basic + Option B (2x) + Option C (1x)
;;M2;Basic + Option B (2x) + Option C (2x)
;;M3;Basic + Option B (2x) + Option C (3x)
;;M4;Basic + Option B (2x) + Option C (4x)
;;M5;Basic + Option B (2x) + Option C (5x)
;;N1;Basic + Option B (2x) + Option A + Option C (1x)
;;N2;Basic + Option B (2x) + Option A + Option C (2x)
;;N3;Basic + Option B (2x) + Option A + Option C (3x)
;;N4;Basic + Option B (2x) + Option A + Option C (4x)
;;N5;Basic + Option B (2x) + Option A + Option C (5x)
;;90;Basic + Option B (3x)
;;P0;Basic + Option B (3x) + Option A
;;Q1;Basic + Option B (3x) + Option C (1x)
;;Q2;Basic + Option B (3x) + Option C (2x)
;;Q3;Basic + Option B (3x) + Option C (3x)
;;Q4;Basic + Option B (3x) + Option C (4x)
;;Q5;Basic + Option B (3x) + Option C (5x)
;;R1;Basic + Option B (3x) + Option A + Option C (1x)
;;R2;Basic + Option B (3x) + Option A + Option C (2x)
;;R3;Basic + Option B (3x) + Option A + Option C (3x)
;;R4;Basic + Option B (3x) + Option A + Option C (4x)
;;R5;Basic + Option B (3x) + Option A + Option C (5x)
;;S0;Basic + Option B (4x)
;;T0;Basic + Option B (4x) + Option A
;;U1;Basic + Option B (4x) + Option C (1x)
;;U2;Basic + Option B (4x) + Option C (2x)
;;U3;Basic + Option B (4x) + Option C (3x)
;;U4;Basic + Option B (4x) + Option C (4x)
;;U5;Basic + Option B (4x) + Option C (5x)
;;V1;Basic + Option B (4x) + Option A + Option C (1x)
;;V2;Basic + Option B (4x) + Option A + Option C (2x)
;;V3;Basic + Option B (4x) + Option A + Option C (3x)
;;V4;Basic + Option B (4x) + Option A + Option C (4x)
;;V5;Basic + Option B (4x) + Option A + Option C (5x)
;;W0;Basic + Option B (5x)
;;X0;Basic + Option B (5x) + Option A
;;Y1;Basic + Option B (5x) + Option C (1x)
;;Y2;Basic + Option B (5x) + Option C (2x)
;;Y3;Basic + Option B (5x) + Option C (3x)
;;Y4;Basic + Option B (5x) + Option C (4x)
;;Y5;Basic + Option B (5x) + Option C (5x)
;;Z1;Basic + Option B (5x) + Option A + Option C (1x)
;;Z2;Basic + Option B (5x) + Option A + Option C (2x)
;;Z3;Basic + Option B (5x) + Option A + Option C (3x)
;;Z4;Basic + Option B (5x) + Option A + Option C (4x)
;;Z5;Basic + Option B (5x) + Option A + Option C (5x)
;;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSXP48 8063 printed Dec 13, 2024@02:28:59 Page 2
PRSXP48 ;LLH/WCIOFO-POST INSTALL UPDATE TO FEGLI CODES;3/26/99
+1 ;;4.0;PAID;**48**;Sep 21, 1995
+2 ;
+3 ;4 callable entry points
+4 ; 1. UPDTFEG - delete FEGLI codes & add NEW codes. Called by
+5 ; patch PRS*4*48 post installation.
+6 ; 2. RSTRFEG - delete new FEGLI codes & restore OLD codes
+7 ; 3. DELOLD - delete all existing codes.
+8 ; 4. ADDFEG(RESTORE) ADD FEGLI codes
+9 ;
+10 ; Routine intended 2b temporary. Delete after PRS*4*48 install.
+11 ;
+12 QUIT
+13 ;==============================================================
UPDTFEG ; UPDATE NEW FEGLI CODES PER VACO.
+1 ; This entry point will delete all existing FEGLI codes
+2 ; from File 454 & then add new codes & descriptions that are changed
+3 ; by VACO-directive 99-119.
+4 ;
+5 DO DELOLD
DO ADDFEG(0)
DO MSSG
+6 QUIT
+7 ;
+8 ;==============================================================
RSTRFEG ;RESTORE OLD FEGLI CODES
+1 ; This entry point restores the FEGLI codes to pre VACO
+2 ; directive 99-119. Coded for testing and just in case need
+3 ; to return to the old codes
+4 ;
+5 DO DELOLD
DO ADDFEG(1)
+6 QUIT
+7 ;
+8 ;==============================================================
DELOLD ; DELETE ALL OF THE OLD FEGLI CODES
+1 ; Loop thru PAID CODE FILES "FEGLI" entry
+2 ; to delete each entry and associated cross references.
+3 ; Inner loop ensures any duplicates are deleted.
+4 ;
+5 NEW DIK,REC,DA
+6 SET REC=""
+7 FOR
SET REC=$ORDER(^PRSP(454,1,"FEG","B",REC))
if REC=""
QUIT
Begin DoDot:1
+8 SET DA=""
+9 FOR
SET DA=$ORDER(^PRSP(454,1,"FEG","B",REC,DA))
if DA=""
QUIT
Begin DoDot:2
+10 SET DIK="^PRSP(454,1,""FEG"","
SET DA(1)=1
+11 DO ^DIK
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
+14 ;==============================================================
ADDFEG(RESTORE) ; ADD FEGLI codes
+1 ; Input: RESTORE - Flag determines label for codes/descriptions
+2 ; Use old codes if RESTORE=1, otherwise new codes.
+3 ;
+4 ; Loop thru new codes & descriptions at label NFEG or OFEG
+5 ; & add to PAID CODE FILES, "FEG" entry.
+6 ;
+7 NEW NEWCODE,CODE,TXT,DIE,DA,DIC,X,DLAYGO,DR
+8 SET RESTORE=$SELECT($GET(RESTORE)=1:RESTORE,1:0)
+9 SET (DIC,DIE)="^PRSP(454,1,""FEG"","
SET DA(1)=1
+10 FOR I=1:1
SET NEWCODE=$$PICKCODE(RESTORE,I)
if NEWCODE=""
QUIT
Begin DoDot:1
+11 KILL DO,DD
+12 SET CODE=$PIECE(NEWCODE,";")
+13 SET X=CODE
SET DIC(0)="L"
SET DLAYGO=454
DO FILE^DICN
+14 SET DA=+Y
+15 SET TXT=$PIECE(NEWCODE,";",2)
+16 SET DR="1///^S X=TXT"
+17 DO ^DIE
End DoDot:1
+18 QUIT
+19 ;==============================================================
PICKCODE(RSTOR,LINE) ;function returns text for FEGLI codes
+1 ; If RSTOR flag > 0 then get old codes otherwise get new.
+2 QUIT $SELECT(RSTOR:$PIECE($TEXT(OFEG+LINE),";;",2),1:$PIECE($TEXT(NFEG+LINE),";;",2))
+3 ;
+4 ;==============================================================
MSSG ;KIDS POST INSTALLATION MESSAGE.
+1 DO MES^XPDUTL(" Updating FEGLI codes.")
+2 HANG 1
+3 DO MES^XPDUTL(" You should delete routine PRSXP48 when installation is complete.")
+4 HANG 1
+5 QUIT
+6 ;==============================================================
OFEG ; old FEGLI Codes and Definitions
+1 ;;A;INELIGIBLE FOR LIFE INSURANCE COVERAGE
+2 ;;B;WAIVED ALL LIFE INSURANCE
+3 ;;C;BASIC LIFE ONLY
+4 ;;D;BASIC LIFE + STANDARD OPTION
+5 ;;E;BASIC LIFE + FAMILY OPTION
+6 ;;F;BASIC LIFE + STANDARD OPTION & FAMILY OPTION
+7 ;;G;BASIC LIFE + ADDITIONAL OPTION WITH 1 X PAY
+8 ;;H;BASIC LIFE + ADDITIONAL OPTION WITH 1 X PAY & STANDARD OPTION
+9 ;;I;BASIC LIFE + ADDITIONAL OPTION WITH 1 X PAY & FAMILY OPTION
+10 ;;J;BASIC LIFE + ADDITIONAL OPTION WITH 1 X PAY & STANDARD OPTION & FAMILY OPTION
+11 ;;K;BASIC LIFE + ADDITIONAL OPTION WITH 2 X PAY
+12 ;;L;BASIC LIFE + ADDITIONAL OPTION WITH 2 X PAY & STANDARD OPTION
+13 ;;M;BASIC LIFE + ADDITIONAL OPTION WITH 2 X PAY & FAMILY OPTION
+14 ;;N;BASIC LIFE + ADDITIONAL OPTION WITH 2 X PAY & STANDARD OPTION & FAMILY OPTION
+15 ;;9;BASIC LIFE + ADDITIONAL OPTION WITH 3 X PAY
+16 ;;P;BASIC LIFE + ADDITIONAL OPTION WITH 3 X PAY & STANDARD OPTION
+17 ;;Q;BASIC LIFE + ADDITIONAL OPTION WITH 3 X PAY & FAMILY OPTION
+18 ;;R;BASIC LIFE + ADDITIONAL OPTION WITH 3 X PAY & STANDARD OPTION & FAMILY OPTION
+19 ;;S;BASIC LIFE + ADDITIONAL OPTION WITH 4 X PAY
+20 ;;T;BASIC LIFE + ADDITIONAL OPTION WITH 4 X PAY & STANDARD OPTION
+21 ;;U;BASIC LIFE + ADDITIONAL OPTION WITH 4 X PAY & FAMILY OPTION
+22 ;;V;BASIC LIFE + ADDITIONAL OPTION WITH 4 X PAY & STANDARD OPTION & FAMILY OPTION
+23 ;;W;BASIC LIFE + ADDITIONAL OPTION WITH 5 X PAY
+24 ;;X;BASIC LIFE + ADDITIONAL OPTION WITH 5 X PAY & STANDARD OPTION
+25 ;;Y;BASIC LIFE + ADDITIONAL OPTION WITH 5 X PAY & FAMILY OPTION
+26 ;;Z;BASIC LIFE + ADDITIONAL OPTION WITH 5 X PAY & STANDARD OPTION & FAMILY OPTION
+27 ;;O;BASIC LIFE + ADDITIONAL OPTION WITH 3 X PAY
+28 ;;
+29 QUIT
+30 ;=============================================================
NFEG ; New FEGLI codes and Descriptions - post Patch 48
+1 ;;A0;Ineligible
+2 ;;B0;Waived
+3 ;;C0;Basic only
+4 ;;D0;Basic + Option A
+5 ;;E1;Basic + Option C (1x)
+6 ;;E2;Basic + Option C (2x)
+7 ;;E3;Basic + Option C (3x)
+8 ;;E4;Basic + Option C (4x)
+9 ;;E5;Basic + Option C (5x)
+10 ;;F1;Basic + Option A + Option C (1x)
+11 ;;F2;Basic + Option A + Option C (2x)
+12 ;;F3;Basic + Option A + Option C (3x)
+13 ;;F4;Basic + Option A + Option C (4x)
+14 ;;F5;Basic + Option A + Option C (5x)
+15 ;;G0;Basic + Option B (1x)
+16 ;;H0;Basic + Option B (1x) + Option A
+17 ;;I1;Basic + Option B (1x) + Option C (1x)
+18 ;;I2;Basic + Option B (1x) + Option C (2x)
+19 ;;I3;Basic + Option B (1x) + Option C (3x)
+20 ;;I4;Basic + Option B (1x) + Option C (4x)
+21 ;;I5;Basic + Option B (1x) + Option C (5x)
+22 ;;J1;Basic + Option B (1x) + Option A + Option C (1x)
+23 ;;J2;Basic + Option B (1x) + Option A + Option C (2x)
+24 ;;J3;Basic + Option B (1x) + Option A + Option C (3x)
+25 ;;J4;Basic + Option B (1x) + Option A + Option C (4x)
+26 ;;J5;Basic + Option B (1x) + Option A + Option C (5x)
+27 ;;K0;Basic + Option B (2x)
+28 ;;L0;Basic + Option B (2x) + Option A
+29 ;;M1;Basic + Option B (2x) + Option C (1x)
+30 ;;M2;Basic + Option B (2x) + Option C (2x)
+31 ;;M3;Basic + Option B (2x) + Option C (3x)
+32 ;;M4;Basic + Option B (2x) + Option C (4x)
+33 ;;M5;Basic + Option B (2x) + Option C (5x)
+34 ;;N1;Basic + Option B (2x) + Option A + Option C (1x)
+35 ;;N2;Basic + Option B (2x) + Option A + Option C (2x)
+36 ;;N3;Basic + Option B (2x) + Option A + Option C (3x)
+37 ;;N4;Basic + Option B (2x) + Option A + Option C (4x)
+38 ;;N5;Basic + Option B (2x) + Option A + Option C (5x)
+39 ;;90;Basic + Option B (3x)
+40 ;;P0;Basic + Option B (3x) + Option A
+41 ;;Q1;Basic + Option B (3x) + Option C (1x)
+42 ;;Q2;Basic + Option B (3x) + Option C (2x)
+43 ;;Q3;Basic + Option B (3x) + Option C (3x)
+44 ;;Q4;Basic + Option B (3x) + Option C (4x)
+45 ;;Q5;Basic + Option B (3x) + Option C (5x)
+46 ;;R1;Basic + Option B (3x) + Option A + Option C (1x)
+47 ;;R2;Basic + Option B (3x) + Option A + Option C (2x)
+48 ;;R3;Basic + Option B (3x) + Option A + Option C (3x)
+49 ;;R4;Basic + Option B (3x) + Option A + Option C (4x)
+50 ;;R5;Basic + Option B (3x) + Option A + Option C (5x)
+51 ;;S0;Basic + Option B (4x)
+52 ;;T0;Basic + Option B (4x) + Option A
+53 ;;U1;Basic + Option B (4x) + Option C (1x)
+54 ;;U2;Basic + Option B (4x) + Option C (2x)
+55 ;;U3;Basic + Option B (4x) + Option C (3x)
+56 ;;U4;Basic + Option B (4x) + Option C (4x)
+57 ;;U5;Basic + Option B (4x) + Option C (5x)
+58 ;;V1;Basic + Option B (4x) + Option A + Option C (1x)
+59 ;;V2;Basic + Option B (4x) + Option A + Option C (2x)
+60 ;;V3;Basic + Option B (4x) + Option A + Option C (3x)
+61 ;;V4;Basic + Option B (4x) + Option A + Option C (4x)
+62 ;;V5;Basic + Option B (4x) + Option A + Option C (5x)
+63 ;;W0;Basic + Option B (5x)
+64 ;;X0;Basic + Option B (5x) + Option A
+65 ;;Y1;Basic + Option B (5x) + Option C (1x)
+66 ;;Y2;Basic + Option B (5x) + Option C (2x)
+67 ;;Y3;Basic + Option B (5x) + Option C (3x)
+68 ;;Y4;Basic + Option B (5x) + Option C (4x)
+69 ;;Y5;Basic + Option B (5x) + Option C (5x)
+70 ;;Z1;Basic + Option B (5x) + Option A + Option C (1x)
+71 ;;Z2;Basic + Option B (5x) + Option A + Option C (2x)
+72 ;;Z3;Basic + Option B (5x) + Option A + Option C (3x)
+73 ;;Z4;Basic + Option B (5x) + Option A + Option C (4x)
+74 ;;Z5;Basic + Option B (5x) + Option A + Option C (5x)
+75 ;;
+76 QUIT
