AGELUP7 ;IHS/ASDS/EFG - UPDATE ELIGIBILITY FROM FILE
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
FILE(AG) ;file RAILROAD RETIREMENT
S AGINSPT=$O(^AUTNINS("B","MEDICARE",0))
S DIE="^AUPNRRE("
S DA=AG("DFN")
I $D(^AUPNRRE(DA,0)) D EDITED
I '$D(^AUPNRRE(DA,0)) D
.S DR=".01////"_DA D ^DIE
.S $P(^AUPNRRE(0),"^",3)=DA
.S $P(^AUPNRRE(0),"^",4)=$P(^(0),"^",4)+1
.D ADDED
I AGINSPT D
.S $P(^AUPNRRE(DA,0),"^",2)=AGINSPT
I AG("FNBR")'="" D
.S DR=".04///"_AG("FNBR") D ^DIE
I AG("FSFX")'="" D
.S DR=".03///"_AG("FSFX") D ^DIE
I AG("FNM")'="" D
.S DR="2101///"_AG("FNM") D ^DIE
I AG("FDOB")'="" D
.S DR="2102///"_AG("FDOB") D ^DIE
S DA(1)=DA
S DIK="^AUPNRRE("_DA(1)_",11,"
S DA=0 F S DA=$O(^AUPNRRE(DA(1),11,DA)) Q:'DA D
.D ^DIK
S DIC="^AUPNRRE("_DA(1)_",11,"
S DIC(0)="LX"
S DIC("P")="9000003.11D"
K DD,DO
S AGI=0
F S AGI=$O(AG("DT",AGI)) Q:'AGI D
.S AGJ=0
.F S AGJ=$O(AG("DT",AGI,AGJ)) Q:AGJ="" D
..S X=$P(AG("DT",AGI,AGJ),"^",1)
..Q:'X
..K DD,DO
..D FILE^DICN
..Q:+Y<0
..S DIE=DIC,DA=+Y
..S AGEDT=$P(AG("DT",AGI,AGJ),"^",2)
..S DR=".02///"_AGEDT D ^DIE
..S AGCVT=$P(AG("DT",AGI,AGJ),"^",3)
..S DR=".03///"_AGCVT D ^DIE
D UPDATE1^AGED(DUZ(2),AG("DFN"),6,"")
K AGEDT,AGCVT,AGI,AGJ
Q
ADDED ;patient added
S:'$D(^AGELUPLG(AGRUN,1,0)) ^(0)="^9009062.021P^^"
S ^AGELUPLG(AGRUN,1,AG("DFN"),0)=AG("DFN")
Q
EDITED ;patient edited
S:'$D(^AGELUPLG(AGRUN,2,0)) ^(0)="^9009062.022P^^"
S ^AGELUPLG(AGRUN,2,AG("DFN"),0)=AG("DFN")
Q
AGELUP7 ;IHS/ASDS/EFG - UPDATE ELIGIBILITY FROM FILE
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
FILE(AG) ;file RAILROAD RETIREMENT
+1 SET AGINSPT=$ORDER(^AUTNINS("B","MEDICARE",0))
+2 SET DIE="^AUPNRRE("
+3 SET DA=AG("DFN")
+4 IF $DATA(^AUPNRRE(DA,0))
DO EDITED
+5 IF '$DATA(^AUPNRRE(DA,0))
Begin DoDot:1
+6 SET DR=".01////"_DA
DO ^DIE
+7 SET $PIECE(^AUPNRRE(0),"^",3)=DA
+8 SET $PIECE(^AUPNRRE(0),"^",4)=$PIECE(^(0),"^",4)+1
+9 DO ADDED
End DoDot:1
+10 IF AGINSPT
Begin DoDot:1
+11 SET $PIECE(^AUPNRRE(DA,0),"^",2)=AGINSPT
End DoDot:1
+12 IF AG("FNBR")'=""
Begin DoDot:1
+13 SET DR=".04///"_AG("FNBR")
DO ^DIE
End DoDot:1
+14 IF AG("FSFX")'=""
Begin DoDot:1
+15 SET DR=".03///"_AG("FSFX")
DO ^DIE
End DoDot:1
+16 IF AG("FNM")'=""
Begin DoDot:1
+17 SET DR="2101///"_AG("FNM")
DO ^DIE
End DoDot:1
+18 IF AG("FDOB")'=""
Begin DoDot:1
+19 SET DR="2102///"_AG("FDOB")
DO ^DIE
End DoDot:1
+20 SET DA(1)=DA
+21 SET DIK="^AUPNRRE("_DA(1)_",11,"
+22 SET DA=0
FOR
SET DA=$ORDER(^AUPNRRE(DA(1),11,DA))
IF 'DA
QUIT
Begin DoDot:1
+23 DO ^DIK
End DoDot:1
+24 SET DIC="^AUPNRRE("_DA(1)_",11,"
+25 SET DIC(0)="LX"
+26 SET DIC("P")="9000003.11D"
+27 KILL DD,DO
+28 SET AGI=0
+29 FOR
SET AGI=$ORDER(AG("DT",AGI))
IF 'AGI
QUIT
Begin DoDot:1
+30 SET AGJ=0
+31 FOR
SET AGJ=$ORDER(AG("DT",AGI,AGJ))
IF AGJ=""
QUIT
Begin DoDot:2
+32 SET X=$PIECE(AG("DT",AGI,AGJ),"^",1)
+33 IF 'X
QUIT
+34 KILL DD,DO
+35 DO FILE^DICN
+36 IF +Y<0
QUIT
+37 SET DIE=DIC
SET DA=+Y
+38 SET AGEDT=$PIECE(AG("DT",AGI,AGJ),"^",2)
+39 SET DR=".02///"_AGEDT
DO ^DIE
+40 SET AGCVT=$PIECE(AG("DT",AGI,AGJ),"^",3)
+41 SET DR=".03///"_AGCVT
DO ^DIE
End DoDot:2
End DoDot:1
+42 DO UPDATE1^AGED(DUZ(2),AG("DFN"),6,"")
+43 KILL AGEDT,AGCVT,AGI,AGJ
+44 QUIT
ADDED ;patient added
+1 IF '$DATA(^AGELUPLG(AGRUN,1,0))
SET ^(0)="^9009062.021P^^"
+2 SET ^AGELUPLG(AGRUN,1,AG("DFN"),0)=AG("DFN")
+3 QUIT
EDITED ;patient edited
+1 IF '$DATA(^AGELUPLG(AGRUN,2,0))
SET ^(0)="^9009062.022P^^"
+2 SET ^AGELUPLG(AGRUN,2,AG("DFN"),0)=AG("DFN")
+3 QUIT
