- 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