Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGELUP7

AGELUP7.m

Go to the documentation of this file.
  1. AGELUP7 ;IHS/ASDS/EFG - UPDATE ELIGIBILITY FROM FILE
  1. ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
  1. ;
  1. FILE(AG) ;file RAILROAD RETIREMENT
  1. S AGINSPT=$O(^AUTNINS("B","MEDICARE",0))
  1. S DIE="^AUPNRRE("
  1. S DA=AG("DFN")
  1. I $D(^AUPNRRE(DA,0)) D EDITED
  1. I '$D(^AUPNRRE(DA,0)) D
  1. .S DR=".01////"_DA D ^DIE
  1. .S $P(^AUPNRRE(0),"^",3)=DA
  1. .S $P(^AUPNRRE(0),"^",4)=$P(^(0),"^",4)+1
  1. .D ADDED
  1. I AGINSPT D
  1. .S $P(^AUPNRRE(DA,0),"^",2)=AGINSPT
  1. I AG("FNBR")'="" D
  1. .S DR=".04///"_AG("FNBR") D ^DIE
  1. I AG("FSFX")'="" D
  1. .S DR=".03///"_AG("FSFX") D ^DIE
  1. I AG("FNM")'="" D
  1. .S DR="2101///"_AG("FNM") D ^DIE
  1. I AG("FDOB")'="" D
  1. .S DR="2102///"_AG("FDOB") D ^DIE
  1. S DA(1)=DA
  1. S DIK="^AUPNRRE("_DA(1)_",11,"
  1. S DA=0 F S DA=$O(^AUPNRRE(DA(1),11,DA)) Q:'DA D
  1. .D ^DIK
  1. S DIC="^AUPNRRE("_DA(1)_",11,"
  1. S DIC(0)="LX"
  1. S DIC("P")="9000003.11D"
  1. K DD,DO
  1. S AGI=0
  1. F S AGI=$O(AG("DT",AGI)) Q:'AGI D
  1. .S AGJ=0
  1. .F S AGJ=$O(AG("DT",AGI,AGJ)) Q:AGJ="" D
  1. ..S X=$P(AG("DT",AGI,AGJ),"^",1)
  1. ..Q:'X
  1. ..K DD,DO
  1. ..D FILE^DICN
  1. ..Q:+Y<0
  1. ..S DIE=DIC,DA=+Y
  1. ..S AGEDT=$P(AG("DT",AGI,AGJ),"^",2)
  1. ..S DR=".02///"_AGEDT D ^DIE
  1. ..S AGCVT=$P(AG("DT",AGI,AGJ),"^",3)
  1. ..S DR=".03///"_AGCVT D ^DIE
  1. D UPDATE1^AGED(DUZ(2),AG("DFN"),6,"")
  1. K AGEDT,AGCVT,AGI,AGJ
  1. Q
  1. ADDED ;patient added
  1. S:'$D(^AGELUPLG(AGRUN,1,0)) ^(0)="^9009062.021P^^"
  1. S ^AGELUPLG(AGRUN,1,AG("DFN"),0)=AG("DFN")
  1. Q
  1. EDITED ;patient edited
  1. S:'$D(^AGELUPLG(AGRUN,2,0)) ^(0)="^9009062.022P^^"
  1. S ^AGELUPLG(AGRUN,2,AG("DFN"),0)=AG("DFN")
  1. Q