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
