AG6.m

AG6 ; IHS/ASDS/EFG - ENTER RAILROAD RETIREMENT DATA ;  

 ;;7.1;PATIENT REGISTRATION;**1,2,11,13**;AUG 25, 2005;Build 1

 ;IHS/OIT/NKD AG*7.1*11 MU2 UNKNOWN SEX

 ;IHS/OIT/NKD AG*7.1*13 MBI IMPLEMENTATION

 ;

L1 S AG("LT")=$S($D(^AUPNRRE(DFN,0)):"YES",1:"NO")

 W !!,"Does this patient have RAILROAD RETIREMENT COVERAGE? (Y/N) "

 W AG("LT"),"// "

 D READ^AG

 S AG("LT")=$S($E(Y)="Y":"YES",1:"NO")

 ;TESTING USE OF EDIT SCREEN FOR ADDING INSURANCE TO NEW PATIENT 5/13/2005

 I $G(^AGFAC(DUZ(2),"NEWADDINS")) I AG("LT")="YES" S AGPAT=$P($G(^DPT(DFN,0)),U) S AGXTERN=1 D EN^AGED6("") K AGXTERN G:$G(NEWENTRY)=0 ^AG7 G L1

 I $G(^AGFAC(DUZ(2),"NEWADDINS")),$D(DUOUT) G DUOUT^AG5

 I $G(^AGFAC(DUZ(2),"NEWADDINS")),($G(AG("LT"))="NO") G ^AG7

 ;TESTING

 Q:$D(DTOUT)!$D(DFOUT)

 G DUOUT^AG5:$D(DUOUT),L2:Y["Y",END1:Y["N"!($D(DLOUT)&(AG("LT")="NO")),L2:$D(DLOUT)&(AG("LT")="YES")

 D YN^AG G L1

ADDNEW ;EP - Add New Railroad Client.

L2 W !

 ;BEGIN AG*7.1*2 IM20637

 I $$ISMINOR^AGUTILS(DFN) D  G:'Y END1

 .K DIR

 .S DIR(0)="Y"

 .S DIR("A")="A MINOR CANNOT BE THE POLICY HOLDER FOR RAILROAD RETIREMENT ..DO YOU WISH TO ADD ENTRY?//"  ;IHS/SD/TPF 4/28/2006 AG*7.1*2 IM20637

 .S DIR("B")="N"

 .D ^DIR

 ;END AG*7.1*2 IM20637

 S NEWENTRY=1  ;IHS/SD/TPF 12/6/2005 AG*7.1*1

 I $G(AGTYPE)="MD" G ADDCOV  ;IHS/SD/TPF 12/6/2005 AG*7.1*1 ITEM 2

 S DIE="^AUPNPAT(",DR=.04,DA=DFN

 D ^DIE

 Q:$D(Y)&$D(AG("EDIT"))

 G L1:$D(Y),L6A:$D(^AUPNRRE(DFN,0))

 S AG("INS")=$O(^AUTNINS("B","RAILROAD RETIREMENT",""))

 K DIC,DIE,DR,DIR,D0,DD

 S DIC="^AUPNRRE("

 S DIC(0)="L"

 S X="`"_DFN

 D ^DIC

 Q:+Y<0

 S DA=+Y

 S DIE="^AUPNRRE("

 S DA=DFN,DR=".02///"_AG("INS")

 D ^DIE

L6A ;

 ;W !!

 ;W "Enter the RAILROAD RET. INSURANCE NUMBER"

 ;W "(""prefix"" will be asked first)."

 ;REQUIRE RR NUMBER

L7 ;

 ;S DR=".03R",DIE="^AUPNRRE("

 ;D ^DIE

 ;I $D(Y) Q:$D(AG("EDIT"))  G L1

 ;REQUIRE RR SUFFIX

L8 ;

 ;S DIE="^AUPNRRE("

 ;S DA=DFN,DR=".04R"

 ;D ^DIE

 ;I $D(Y) G L7

 D EDITRRE^AGUTL(DFN,1)  ;IHS/OIT/NKD AG*7.1*13

 S DIE="^AUPNRRE(",DA=DFN

 S ADDCHK=""

 ;REQUIRE RR NAME

RRNM S DR="2101R"

 I $G(NEWENTRY)!($P($G(^AUPNRRE(DA,21)),U)="") S DR=DR_"//"_$P($G(^DPT(DFN,0)),U)

 D ^DIE

 I '$D(^AUPNRRE(DFN,21)) G RRDB

 I $P(^AUPNRRE(DFN,21),U)]"" D

 .S DIE="^DPT(",DA=DFN

 .S DR="1///"_$P(^AUPNRRE(DFN,21),U),DR(2,2.01)=.01

 .D ^DIE

QMB S DIE="^AUPNRRE("

 S DA=DFN,DR=.08

 D ^DIE

SIG S DIE="^AUPNRRE("

 S DA=DFN,DR=.11

 D ^DIE

SIGD S DIE="^AUPNRRE("

 S DA=DFN,DR=.12

 D ^DIE

PCP S DIE="^AUPNRRE("

 S DA=DFN,DR=.14

 D ^DIE

CC S DIE="^AUPNRRE("

 S DA=DFN,DR=.15

 D ^DIE

CCD S DIE="^AUPNRRE("

 S DA=DFN,DR=.16

 D ^DIE

 ;REQUIRE RR DOB

RRDB S DR="2102R"

 I $G(NEWENTRY)!($P($G(^AUPNRRE(DA,21)),U,2)="") N AGDOB,Y S Y=$P($G(^DPT(DFN,0)),U,3) X ^DD("DD") S AGDOB=Y S DR=DR_"//"_AGDOB K Y

 D ^DIE

ADDCOV ;EP - Add New Coverage.

L9 W !!,"Enter the ELIGIBILITY DATE: "

 D:'$D(AG("EDIT")) DFLT1

 D READ^AG

 I $D(DUOUT) W !,"ELIGIBLITY DATE REQUIRED!" H 2 G ADDCOV

 I $D(DTOUT)!$D(DFOUT)!($D(DLOUT)) W !,"ELIGIBLITY DATE REQUIRED!" H 2 G ADDCOV

 Q:$D(DUOUT)&$D(AG("EDIT"))

 G END1:$D(DTOUT)!$D(DFOUT)!($D(DLOUT)&'$D(AG("LT1")))

 G L8:$D(DUOUT),L9A:$D(DLOUT)

 S:$D(DQOUT) Y="?"

 S X=Y,%DT="EX"

 D ^%DT

 G L9:Y<2600000!(Y>(DT+20000))

 I Y>DT D

 .W *7,!!,"SURE ABOUT THE FUTURE START DATE"

 .S %=2

 .D YN^DICN G:%=2 L9

 S AG("DT")=Y

 K AG("COV"),COVTYP  ;IHS/OIT/NKD AG*7.1*13

 ;L9A I $G(AGTYPE)="MD" S AG("COV")="D" K AG("MORE") G L10  ;IHS/SD/TPF 12/2/2005 AG*7.1*1

L9A  ;I $G(AGTYPE)="MD" S AG("COV")="D" K AG("MORE") G L10  ;IHS/SD/TPF 12/2/2005 AG*7.1*1  ;IHS/OIT/NKD AG*7.1*13

 ;W !!,"Type of COVERAGE (A, B): "

 W !!,"Type of COVERAGE (A, B, D): "

 D:'$D(AG("EDIT")) DFLT2

 D READ^AG

 I Y="D",$$NOPARTAB^AGED6(DFN) W !,"PATIENT MUST HAVE RAILROAD PART A OR B BEFORE BEING ELIGIBLE FOR PART D!" G L8  ;AG*7.1*1 ITEM 2

 ;I Y="D",AGELP("INS")=1 W !!,"DO NOT ADD PART D COVERAGE TO RAILROAD RETIREMENT",!,"REFER TO PATCH 1 ADDENDUM IN HOW TO SET UP PART D INSURERS",! G L8  ;IHS/SD/TPF 4/25/2006 AG*7.1*2 IM20523

 ;I Y="D",($P($G(^AUTNINS(AGELP("INS"),2)),U)'="MD") W !!,"CAN NOT ADD PART D COVERAGE TO A NON MEDICARE PART D INSURER",!,"REFER TO PATCH 1 ADDENDUM IN HOW TO SET UP PART D INSURERS",! G L8

 ;I Y="" W !,"Enter either ""A"" or ""B""." G L9A

 I Y="" W !,"Enter either ""A"" or ""B"" or ""D""." G L9A

 G END1:$D(DTOUT)!$D(DFOUT)!($D(DLOUT)&'$D(AG("LT2"))),L9:$D(DUOUT),L10:$D(DLOUT)

 ;I $D(DQOUT)!((Y'="A")&(Y'="B")) W !,"Enter either ""A"" or ""B""."

 I $D(DQOUT)!((Y'="A")&(Y'="B")&(Y'="D")) W !,"Enter either ""A"" or ""B"" or ""D""." G L9A

 S AG("COV")=Y

 K AG("MORE")

L10 S DIE="^AUPNRRE("

 ;LINE BELOW ALLOWS ENTRY OF SAME DATE EVEN THOUGH THIS FIELD IS DINUMED

 ;THIS IS SO RAILROAD PART A AND B CAN BE ENTERED UNDER THE SAME DATE

 S DR="1101///"_$C(34)_AG("DT")_$C(34)

 S DR(2,9000005.11)=".03///"_AG("COV"),DA=DFN

 ;IHS/OIT/NKD AG*7.1*11 MU2 - STUFF PT SEX INTO ELIGIBLE SEX FIELD - START NEW CODE

 N AGSEX

 S AGSEX=$$GET1^DIQ(2,DFN,.02,"I")

 S DR(2,9000005.11)=DR(2,9000005.11)_";.08////^S X=AGSEX"

 ;IHS/OIT/NKD AG*7.1*11 MU2 - END NEW CODE

 D ^DIE

 S WD0=DFN,WD1=$O(^AUPNRRE(WD0,11,"B",AG("DT"),""))

 S COMPIEN=WD0_",11,"_WD1

 ;BEGIN NEW CODE IHS/SD/TPF 12/2/2005 AG*7.1*1 ITEM 1

 I $G(AG("COV"))="D" D ASKPARTD(DFN,D1) S NEWENTRY=0 D EN^AGED6PD(COMPIEN) K AG("MORE") Q:$D(AG("EDIT"))  ;AG*7.1*2 ;AG*7.1*2 REPORTED DURING ALPHA 11/9/2006 AG("EDIT") SHOULD BE DEFINED ONLY WHEN EDITING A PAT.

 I $G(GOL8) G L9A  ;IHS/SD/TPF 12/2/2005 AG*7.1*1 ITEM 1

 K DIE,DIC,DR,DA

 ;END NEW CODE

END Q:$D(AG("EDIT"))

 D MORE

 G ADDCOV:$D(AG("MORE"))

 K AG

 G ^AG7

END1 G END:'$D(^AUPNRRE(DFN,0))!$D(AG("EDIT"))

 S DA=DFN,DIE="^AUPNRRE("

 S DR=".01///@"

 D ^DIE

 G END

DUOUT ;EP

 G L1

DFLT1 K AG("LT1")

 Q:'$D(^AUPNRRE(DFN,11,1,0))

 S DIC=9000005.11,DR=.01,DA=DFN,AG("DRENT")=1

 ;REQUIRE ELIG BEGIN DATE

 S DR=".01R"  ;AG*7.1*1 ITEM 2

 D ^AGDICLK

 Q:$D(AG("LKERR"))

 S AG("LT1")=AG("LKPRINT"),AG("DT")=AG("LKDATA")

 W AG("LKPRINT"),"// "

 Q

DFLT2 K AG("LT2")

 Q:'$D(^AUPNRRE(DFN,11,1,0))

 S (AG("LT2"),AG("COV"))=$P(^AUPNRRE(DFN,11,1,0),U,3)

 Q:AG("LT2")=""

 W AG("LT2"),"// "

 Q

MORE K AG("MORE")

 Q:'$D(^AUPNRRE(DFN,11,0))

 W !!,"Do you wish to ADD ANOTHER COVERAGE TYPE? (Y/N) NO// "

 D READ^AG

 Q:$D(DTOUT)!$D(DFOUT)!$D(DLOUT)!(Y["N")

 G MORE1:Y["Y"

 D YN^AG

 G MORE

MORE1 S AG("MORE")=""

 Q

ASKPARTD(DFN,D1) ;ASK PART D FIELDS

 K DIC,DIE,DR,DA

 S GOL8=0

 S DA=D1

 S DA(1)=DFN

 S DIE="^AUPNRRE("_DA(1)_",11,"

F04 ;EP

 S COMPIEN=DA(1)_",11,"_DA_",0"

 ;I $G(AGELP("INS"))'="" S DR=".04R//^S X=$P(^AUTNINS($G(AGELP(""INS"")),0),U)"

 I $G(AGELP("INS"))'="",($G(AGELP("INS"))'=1) S DR=".04R//^S X=$P(^AUTNINS($G(AGELP(""INS"")),0),U)"

 E  S DR=".04R"

 D ^DIE

 I $D(Y) S GOL8=1 Q

F05 ;EP

 S DR=".05R//^S X=$P($G(^AUPNRRE(DA(1),21)),U)"

 D ^DIE

 I $D(Y) G F04

F06 ;EP

 K DR

 S DR=".06R//^S X=$P($G(^AUPNRRE(DA(1),0)),U,4)"

 S DR=".06R//"_$$GETRRE^AGUTL(DFN)  ;IHS/OIT/NKD AG*7.1*13

 D ^DIE

 I $D(Y) G F05

F07 ;EP

 S DR=".07"

 D ^DIE

 I $D(Y) G F06

F08 ;EP

 S DR=".08R//^S X=$P($G(^DPT(DA(1),0)),U,2)"

 D ^DIE

 I $D(Y) G F07

F09 ;EP

 S DR=".09R//^S X=$P($G(^DPT(DA(1),0)),U,3)"

 D ^DIE

 I $D(Y) G F08

F11 ;EP

 S DR=".11"

 D ^DIE

 I $D(Y) G F09

F13 ;EP

 S DR=".13R"

 D ^DIE

 I $D(Y) G F11

 Q

AG6       ; IHS/ASDS/EFG - ENTER RAILROAD RETIREMENT DATA ;  

 +1       ;;7.1;PATIENT REGISTRATION;**1,2,11,13**;AUG 25, 2005;Build 1

 +2       ;IHS/OIT/NKD AG*7.1*11 MU2 UNKNOWN SEX

 +3       ;IHS/OIT/NKD AG*7.1*13 MBI IMPLEMENTATION

 +4       ;

L1         SET AG("LT")=$SELECT($DATA(^AUPNRRE(DFN,0)):"YES",1:"NO")

 +1        WRITE !!,"Does this patient have RAILROAD RETIREMENT COVERAGE? (Y/N) "

 +2        WRITE AG("LT"),"// "

 +3        DO READ^AG

 +4        SET AG("LT")=$SELECT($EXTRACT(Y)="Y":"YES",1:"NO")

 +5       ;TESTING USE OF EDIT SCREEN FOR ADDING INSURANCE TO NEW PATIENT 5/13/2005

 +6        IF $GET(^AGFAC(DUZ(2),"NEWADDINS"))

               IF AG("LT")="YES"

                   SET AGPAT=$PIECE($GET(^DPT(DFN,0)),U)

                   SET AGXTERN=1

                   DO EN^AGED6("")

                   KILL AGXTERN

                   IF $GET(NEWENTRY)=0

                       GOTO ^AG7

                   GOTO L1

 +7        IF $GET(^AGFAC(DUZ(2),"NEWADDINS"))

               IF $DATA(DUOUT)

                   GOTO DUOUT^AG5

 +8        IF $GET(^AGFAC(DUZ(2),"NEWADDINS"))

               IF ($GET(AG("LT"))="NO")

                   GOTO ^AG7

 +9       ;TESTING

 +10       IF $DATA(DTOUT)!$DATA(DFOUT)

               QUIT 

 +11       IF $DATA(DUOUT)

               GOTO DUOUT^AG5

           IF Y["Y"

               GOTO L2

           IF Y["N"!($DATA(DLOUT)&(AG("LT")="NO"))

               GOTO END1

           IF $DATA(DLOUT)&(AG("LT")="YES")

               GOTO L2

 +12       DO YN^AG

           GOTO L1

ADDNEW    ;EP - Add New Railroad Client.

L2         WRITE !

 +1       ;BEGIN AG*7.1*2 IM20637

 +2        IF $$ISMINOR^AGUTILS(DFN)

               Begin DoDot:1

 +3                KILL DIR

 +4                SET DIR(0)="Y"

 +5       ;IHS/SD/TPF 4/28/2006 AG*7.1*2 IM20637

                   SET DIR("A")="A MINOR CANNOT BE THE POLICY HOLDER FOR RAILROAD RETIREMENT ..DO YOU WISH TO ADD ENTRY?//"

 +6                SET DIR("B")="N"

 +7                DO ^DIR

               End DoDot:1

               IF 'Y

                   GOTO END1

 +8       ;END AG*7.1*2 IM20637

 +9       ;IHS/SD/TPF 12/6/2005 AG*7.1*1

           SET NEWENTRY=1

 +10      ;IHS/SD/TPF 12/6/2005 AG*7.1*1 ITEM 2

           IF $GET(AGTYPE)="MD"

               GOTO ADDCOV

 +11       SET DIE="^AUPNPAT("

           SET DR=.04

           SET DA=DFN

 +12       DO ^DIE

 +13       IF $DATA(Y)&$DATA(AG("EDIT"))

               QUIT 

 +14       IF $DATA(Y)

               GOTO L1

           IF $DATA(^AUPNRRE(DFN,0))

               GOTO L6A

 +15       SET AG("INS")=$ORDER(^AUTNINS("B","RAILROAD RETIREMENT",""))

 +16       KILL DIC,DIE,DR,DIR,D0,DD

 +17       SET DIC="^AUPNRRE("

 +18       SET DIC(0)="L"

 +19       SET X="`"_DFN

 +20       DO ^DIC

 +21       IF +Y<0

               QUIT 

 +22       SET DA=+Y

 +23       SET DIE="^AUPNRRE("

 +24       SET DA=DFN

           SET DR=".02///"_AG("INS")

 +25       DO ^DIE

L6A       ;

 +1       ;W !!

 +2       ;W "Enter the RAILROAD RET. INSURANCE NUMBER"

 +3       ;W "(""prefix"" will be asked first)."

 +4       ;REQUIRE RR NUMBER

L7        ;

 +1       ;S DR=".03R",DIE="^AUPNRRE("

 +2       ;D ^DIE

 +3       ;I $D(Y) Q:$D(AG("EDIT"))  G L1

 +4       ;REQUIRE RR SUFFIX

L8        ;

 +1       ;S DIE="^AUPNRRE("

 +2       ;S DA=DFN,DR=".04R"

 +3       ;D ^DIE

 +4       ;I $D(Y) G L7

 +5       ;IHS/OIT/NKD AG*7.1*13

           DO EDITRRE^AGUTL(DFN,1)

 +6        SET DIE="^AUPNRRE("

           SET DA=DFN

 +7        SET ADDCHK=""

 +8       ;REQUIRE RR NAME

RRNM       SET DR="2101R"

 +1        IF $GET(NEWENTRY)!($PIECE($GET(^AUPNRRE(DA,21)),U)="")

               SET DR=DR_"//"_$PIECE($GET(^DPT(DFN,0)),U)

 +2        DO ^DIE

 +3        IF '$DATA(^AUPNRRE(DFN,21))

               GOTO RRDB

 +4        IF $PIECE(^AUPNRRE(DFN,21),U)]""

               Begin DoDot:1

 +5                SET DIE="^DPT("

                   SET DA=DFN

 +6                SET DR="1///"_$PIECE(^AUPNRRE(DFN,21),U)

                   SET DR(2,2.01)=.01

 +7                DO ^DIE

               End DoDot:1

QMB        SET DIE="^AUPNRRE("

 +1        SET DA=DFN

           SET DR=.08

 +2        DO ^DIE

SIG        SET DIE="^AUPNRRE("

 +1        SET DA=DFN

           SET DR=.11

 +2        DO ^DIE

SIGD       SET DIE="^AUPNRRE("

 +1        SET DA=DFN

           SET DR=.12

 +2        DO ^DIE

PCP        SET DIE="^AUPNRRE("

 +1        SET DA=DFN

           SET DR=.14

 +2        DO ^DIE

CC         SET DIE="^AUPNRRE("

 +1        SET DA=DFN

           SET DR=.15

 +2        DO ^DIE

CCD        SET DIE="^AUPNRRE("

 +1        SET DA=DFN

           SET DR=.16

 +2        DO ^DIE

 +3       ;REQUIRE RR DOB

RRDB       SET DR="2102R"

 +1        IF $GET(NEWENTRY)!($PIECE($GET(^AUPNRRE(DA,21)),U,2)="")

               NEW AGDOB,Y

               SET Y=$PIECE($GET(^DPT(DFN,0)),U,3)

               XECUTE ^DD("DD")

               SET AGDOB=Y

               SET DR=DR_"//"_AGDOB

               KILL Y

 +2        DO ^DIE

ADDCOV    ;EP - Add New Coverage.

L9         WRITE !!,"Enter the ELIGIBILITY DATE: "

 +1        IF '$DATA(AG("EDIT"))

               DO DFLT1

 +2        DO READ^AG

 +3        IF $DATA(DUOUT)

               WRITE !,"ELIGIBLITY DATE REQUIRED!"

               HANG 2

               GOTO ADDCOV

 +4        IF $DATA(DTOUT)!$DATA(DFOUT)!($DATA(DLOUT))

               WRITE !,"ELIGIBLITY DATE REQUIRED!"

               HANG 2

               GOTO ADDCOV

 +5        IF $DATA(DUOUT)&$DATA(AG("EDIT"))

               QUIT 

 +6        IF $DATA(DTOUT)!$DATA(DFOUT)!($DATA(DLOUT)&'$DATA(AG("LT1")))

               GOTO END1

 +7        IF $DATA(DUOUT)

               GOTO L8

           IF $DATA(DLOUT)

               GOTO L9A

 +8        IF $DATA(DQOUT)

               SET Y="?"

 +9        SET X=Y

           SET %DT="EX"

 +10       DO ^%DT

 +11       IF Y<2600000!(Y>(DT+20000))

               GOTO L9

 +12       IF Y>DT

               Begin DoDot:1

 +13               WRITE *7,!!,"SURE ABOUT THE FUTURE START DATE"

 +14               SET %=2

 +15               DO YN^DICN

                   IF %=2

                       GOTO L9

               End DoDot:1

 +16       SET AG("DT")=Y

 +17      ;IHS/OIT/NKD AG*7.1*13

           KILL AG("COV"),COVTYP

 +18      ;L9A I $G(AGTYPE)="MD" S AG("COV")="D" K AG("MORE") G L10  ;IHS/SD/TPF 12/2/2005 AG*7.1*1

L9A       ;I $G(AGTYPE)="MD" S AG("COV")="D" K AG("MORE") G L10  ;IHS/SD/TPF 12/2/2005 AG*7.1*1  ;IHS/OIT/NKD AG*7.1*13

 +1       ;W !!,"Type of COVERAGE (A, B): "

 +2        WRITE !!,"Type of COVERAGE (A, B, D): "

 +3        IF '$DATA(AG("EDIT"))

               DO DFLT2

 +4        DO READ^AG

 +5       ;AG*7.1*1 ITEM 2

           IF Y="D"

               IF $$NOPARTAB^AGED6(DFN)

                   WRITE !,"PATIENT MUST HAVE RAILROAD PART A OR B BEFORE BEING ELIGIBLE FOR PART D!"

                   GOTO L8

 +6       ;I Y="D",AGELP("INS")=1 W !!,"DO NOT ADD PART D COVERAGE TO RAILROAD RETIREMENT",!,"REFER TO PATCH 1 ADDENDUM IN HOW TO SET UP PART D INSURERS",! G L8  ;IHS/SD/TPF 4/25/2006 AG*7.1*2 IM20523

 +7       ;I Y="D",($P($G(^AUTNINS(AGELP("INS"),2)),U)'="MD") W !!,"CAN NOT ADD PART D COVERAGE TO A NON MEDICARE PART D INSURER",!,"REFER TO PATCH 1 ADDENDUM IN HOW TO SET UP PART D INSURERS",! G L8

 +8       ;I Y="" W !,"Enter either ""A"" or ""B""." G L9A

 +9        IF Y=""

               WRITE !,"Enter either ""A"" or ""B"" or ""D""."

               GOTO L9A

 +10       IF $DATA(DTOUT)!$DATA(DFOUT)!($DATA(DLOUT)&'$DATA(AG("LT2")))

               GOTO END1

           IF $DATA(DUOUT)

               GOTO L9

           IF $DATA(DLOUT)

               GOTO L10

 +11      ;I $D(DQOUT)!((Y'="A")&(Y'="B")) W !,"Enter either ""A"" or ""B""."

 +12       IF $DATA(DQOUT)!((Y'="A")&(Y'="B")&(Y'="D"))

               WRITE !,"Enter either ""A"" or ""B"" or ""D""."

               GOTO L9A

 +13       SET AG("COV")=Y

 +14       KILL AG("MORE")

L10        SET DIE="^AUPNRRE("

 +1       ;LINE BELOW ALLOWS ENTRY OF SAME DATE EVEN THOUGH THIS FIELD IS DINUMED

 +2       ;THIS IS SO RAILROAD PART A AND B CAN BE ENTERED UNDER THE SAME DATE

 +3        SET DR="1101///"_$CHAR(34)_AG("DT")_$CHAR(34)

 +4        SET DR(2,9000005.11)=".03///"_AG("COV")

           SET DA=DFN

 +5       ;IHS/OIT/NKD AG*7.1*11 MU2 - STUFF PT SEX INTO ELIGIBLE SEX FIELD - START NEW CODE

 +6        NEW AGSEX

 +7        SET AGSEX=$$GET1^DIQ(2,DFN,.02,"I")

 +8        SET DR(2,9000005.11)=DR(2,9000005.11)_";.08////^S X=AGSEX"

 +9       ;IHS/OIT/NKD AG*7.1*11 MU2 - END NEW CODE

 +10       DO ^DIE

 +11       SET WD0=DFN

           SET WD1=$ORDER(^AUPNRRE(WD0,11,"B",AG("DT"),""))

 +12       SET COMPIEN=WD0_",11,"_WD1

 +13      ;BEGIN NEW CODE IHS/SD/TPF 12/2/2005 AG*7.1*1 ITEM 1

 +14      ;AG*7.1*2 ;AG*7.1*2 REPORTED DURING ALPHA 11/9/2006 AG("EDIT") SHOULD BE DEFINED ONLY WHEN EDITING A PAT.

           IF $GET(AG("COV"))="D"

               DO ASKPARTD(DFN,D1)

               SET NEWENTRY=0

               DO EN^AGED6PD(COMPIEN)

               KILL AG("MORE")

               IF $DATA(AG("EDIT"))

                   QUIT 

 +15      ;IHS/SD/TPF 12/2/2005 AG*7.1*1 ITEM 1

           IF $GET(GOL8)

               GOTO L9A

 +16       KILL DIE,DIC,DR,DA

 +17      ;END NEW CODE

END        IF $DATA(AG("EDIT"))

               QUIT 

 +1        DO MORE

 +2        IF $DATA(AG("MORE"))

               GOTO ADDCOV

 +3        KILL AG

 +4        GOTO ^AG7

END1       IF '$DATA(^AUPNRRE(DFN,0))!$DATA(AG("EDIT"))

               GOTO END

 +1        SET DA=DFN

           SET DIE="^AUPNRRE("

 +2        SET DR=".01///@"

 +3        DO ^DIE

 +4        GOTO END

DUOUT     ;EP

 +1        GOTO L1

DFLT1      KILL AG("LT1")

 +1        IF '$DATA(^AUPNRRE(DFN,11,1,0))

               QUIT 

 +2        SET DIC=9000005.11

           SET DR=.01

           SET DA=DFN

           SET AG("DRENT")=1

 +3       ;REQUIRE ELIG BEGIN DATE

 +4       ;AG*7.1*1 ITEM 2

           SET DR=".01R"

 +5        DO ^AGDICLK

 +6        IF $DATA(AG("LKERR"))

               QUIT 

 +7        SET AG("LT1")=AG("LKPRINT")

           SET AG("DT")=AG("LKDATA")

 +8        WRITE AG("LKPRINT"),"// "

 +9        QUIT 

DFLT2      KILL AG("LT2")

 +1        IF '$DATA(^AUPNRRE(DFN,11,1,0))

               QUIT 

 +2        SET (AG("LT2"),AG("COV"))=$PIECE(^AUPNRRE(DFN,11,1,0),U,3)

 +3        IF AG("LT2")=""

               QUIT 

 +4        WRITE AG("LT2"),"// "

 +5        QUIT 

MORE       KILL AG("MORE")

 +1        IF '$DATA(^AUPNRRE(DFN,11,0))

               QUIT 

 +2        WRITE !!,"Do you wish to ADD ANOTHER COVERAGE TYPE? (Y/N) NO// "

 +3        DO READ^AG

 +4        IF $DATA(DTOUT)!$DATA(DFOUT)!$DATA(DLOUT)!(Y["N")

               QUIT 

 +5        IF Y["Y"

               GOTO MORE1

 +6        DO YN^AG

 +7        GOTO MORE

MORE1      SET AG("MORE")=""

 +1        QUIT 

ASKPARTD(DFN,D1) ;ASK PART D FIELDS

 +1        KILL DIC,DIE,DR,DA

 +2        SET GOL8=0

 +3        SET DA=D1

 +4        SET DA(1)=DFN

 +5        SET DIE="^AUPNRRE("_DA(1)_",11,"

F04       ;EP

 +1        SET COMPIEN=DA(1)_",11,"_DA_",0"

 +2       ;I $G(AGELP("INS"))'="" S DR=".04R//^S X=$P(^AUTNINS($G(AGELP(""INS"")),0),U)"

 +3        IF $GET(AGELP("INS"))'=""

               IF ($GET(AGELP("INS"))'=1)

                   SET DR=".04R//^S X=$P(^AUTNINS($G(AGELP(""INS"")),0),U)"

 +4       IF '$TEST

               SET DR=".04R"

 +5        DO ^DIE

 +6        IF $DATA(Y)

               SET GOL8=1

               QUIT 

F05       ;EP

 +1        SET DR=".05R//^S X=$P($G(^AUPNRRE(DA(1),21)),U)"

 +2        DO ^DIE

 +3        IF $DATA(Y)

               GOTO F04

F06       ;EP

 +1        KILL DR

 +2        SET DR=".06R//^S X=$P($G(^AUPNRRE(DA(1),0)),U,4)"

 +3       ;IHS/OIT/NKD AG*7.1*13

           SET DR=".06R//"_$$GETRRE^AGUTL(DFN)

 +4        DO ^DIE

 +5        IF $DATA(Y)

               GOTO F05

F07       ;EP

 +1        SET DR=".07"

 +2        DO ^DIE

 +3        IF $DATA(Y)

               GOTO F06

F08       ;EP

 +1        SET DR=".08R//^S X=$P($G(^DPT(DA(1),0)),U,2)"

 +2        DO ^DIE

 +3        IF $DATA(Y)

               GOTO F07

F09       ;EP

 +1        SET DR=".09R//^S X=$P($G(^DPT(DA(1),0)),U,3)"

 +2        DO ^DIE

 +3        IF $DATA(Y)

               GOTO F08

F11       ;EP

 +1        SET DR=".11"

 +2        DO ^DIE

 +3        IF $DATA(Y)

               GOTO F09

F13       ;EP

 +1        SET DR=".13R"

 +2        DO ^DIE

 +3        IF $DATA(Y)

               GOTO F11

 +4        QUIT