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
AG9924 ;IHS/OIT/NKD - MCD Eligiblity fix ; 02/19/2015
+1 ;;99.1;IHS DICTIONARIES (PATIENT);**24**;MAR 9, 1999;Build 1
+2 ;
EN(DFN,REC,OLD,NEW) ; EP - MCD ELIGIBILITY FIX
+1 NEW AGDFN,AGREC,AGOLD,AGNEW,AGS1,AGS2,AGV2,AGI,AGDAT
+2 SET AGDFN=$GET(DFN)
SET AGREC=$GET(REC)
SET AGOLD=$GET(OLD)
SET AGNEW=$GET(NEW)
+3 IF 'AGDFN
QUIT
IF 'AGREC
QUIT
IF 'AGOLD
QUIT
IF 'AGNEW
QUIT
+4 SET AGS1="D"_AGREC
SET AGS2=AGREC_",11,"_AGOLD_","_0
SET AGV2=AGREC_",11,"_AGNEW_","_0
+5 SET AGI=0
FOR
SET AGI=$ORDER(^AUPNICP("C",AGDFN,AGI))
IF 'AGI
QUIT
Begin DoDot:1
+6 SET AGDAT=$GET(^AUPNICP(AGI,0))
IF AGDAT']""
QUIT
+7 IF $PIECE(AGDAT,U,2)'=AGDFN
QUIT
+8 IF $PIECE(AGDAT,U,12)'=AGS1
QUIT
+9 IF $PIECE(AGDAT,U,14)'=AGS2
QUIT
+10 DO LOG^AUPNMCDF(9000035,AGI,.15,$PIECE(AGDAT,U,14))
+11 SET $PIECE(^AUPNICP(AGI,0),U,14)=AGV2
End DoDot:1
+12 QUIT