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

AG9924.m

Go to the documentation of this file.
AG9924 ;IHS/OIT/NKD - MCD Eligiblity fix ; 02/19/2015
 ;;99.1;IHS DICTIONARIES (PATIENT);**24**;MAR 9, 1999;Build 1
 ;
EN(DFN,REC,OLD,NEW) ; EP - MCD ELIGIBILITY FIX
 N AGDFN,AGREC,AGOLD,AGNEW,AGS1,AGS2,AGV2,AGI,AGDAT
 S AGDFN=$G(DFN),AGREC=$G(REC),AGOLD=$G(OLD),AGNEW=$G(NEW)
 Q:'AGDFN  Q:'AGREC  Q:'AGOLD  Q:'AGNEW
 S AGS1="D"_AGREC,AGS2=AGREC_",11,"_AGOLD_","_0,AGV2=AGREC_",11,"_AGNEW_","_0
 S AGI=0 F  S AGI=$O(^AUPNICP("C",AGDFN,AGI)) Q:'AGI  D
 . S AGDAT=$G(^AUPNICP(AGI,0)) Q:AGDAT']""
 . Q:$P(AGDAT,U,2)'=AGDFN
 . Q:$P(AGDAT,U,12)'=AGS1
 . Q:$P(AGDAT,U,14)'=AGS2
 . D LOG^AUPNMCDF(9000035,AGI,.15,$P(AGDAT,U,14))
 . S $P(^AUPNICP(AGI,0),U,14)=AGV2
 Q