ACHSVUR1 ; IHS/ITSC/PMF - NO DESCRIPTION PROVIDED ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;routine created 9/11/00 to check eligibility changes
;
PRVTST ;EP from ACHSVUR
;TEST FOR PRIVATE INSURANCE ELIGIBLE DURING DATE OF SERVICE
S I=0
S CT=0
F S I=$O(^AUPNPRVT(DFN,11,I)) Q:(I'?1N.N)!(CT=1) D
.S ELGBDAT=$P(^AUPNPRVT(DFN,11,I,0),U,6)
.S ELGEDAT=$P(^AUPNPRVT(DFN,11,I,0),U,7)
.S AUTHBDOS=$P(^ACHSF(DUZ(2),"D",DA,3),U)
.S AUTHEDOS=$P(^ACHSF(DUZ(2),"D",DA,3),U,2)
.I (ELGEDAT="")&(AUTHBDOS>ELGBDAT) S CT=CT+1 W ?65,"Y"
.I (ELGEDAT'="")&(AUTHBDOS>ELGBDAT)&(AUTHBDOS<ELGEDAT) S CT=CT+1 W ?65,"Y"
K ELGBDAT,ELGEDAT,AUTHBOS,AUTHEDOS,I,CT
Q
MCDTST ;EP from ACHSVUR
;TEST FOR MEDICAID INSURANCE ELIGIBLE DURING DATE OF SERVICE
S CT=0
S M=0
S M=$O(^AUPNMCD("B",DFN,M)) Q:'+M D
.S MCDDFN=M
.Q
S I=0
F S I=$O(^AUPNMCD(MCDDFN,11,I)) Q:(I'?1N.N)!(CT=1) D
.S ELGBDAT=$P(^AUPNMCD(MCDDFN,11,I,0),U)
.S ELGEDAT=$P(^AUPNMCD(MCDDFN,11,I,0),U,2)
.S AUTHBDOS=$P(^ACHSF(DUZ(2),"D",DA,3),U)
.S AUTHEDOS=$P(^ACHSF(DUZ(2),"D",DA,3),U,2)
.I (ELGEDAT="")&(AUTHBDOS>ELGBDAT) S CT=CT+1 W ?65,"Y"
.I (ELGEDAT'="")&(AUTHBDOS>ELGBDAT)&(AUTHBDOS<ELGEDAT) S CT=CT+1 W ?65,"Y"
K ELGBDAT,ELGEDAT,AUTHBOS,AUTHEDOS,I,M,MCDDFN,CT
Q
MCRTST ;EP from ACHSVUR
;TEST FOR MEDICARE INSURANCE ELIGIBLE DURING DATE OF SERVICE
S CT=0
S I=0
F S I=$O(^AUPNMCR(DFN,11,I)) Q:(I'?1N.N)!(CT=1) D
.S ELGBDAT=$P(^AUPNMCR(DFN,11,I,0),U)
.S ELGEDAT=$P(^AUPNMCR(DFN,11,I,0),U,2)
.S AUTHBDOS=$P(^ACHSF(DUZ(2),"D",DA,3),U)
.S AUTHEDOS=$P(^ACHSF(DUZ(2),"D",DA,3),U,2)
.I (ELGEDAT="")&(AUTHBDOS>ELGBDAT) S CT=CT+1 W ?65,"Y"
.I (ELGEDAT'="")&(AUTHBDOS>ELGBDAT)&(AUTHBDOS<ELGEDAT) S CT=CT+1 W ?65,"Y"
K ELGBDAT,ELGEDAT,AUTHBOS,AUTHEDOS,I,CT
Q
RRETST ;EP from ACHSVUR
;TEST FOR RAILROAD INSURANCE ELIGIBLE DURING DATE OF SERVICE
S CT=0
S I=0
F S I=$O(^AUPNRRE(DFN,11,I)) Q:(I'?1N.N)!(CT=1) D
.S ELGBDAT=$P(^AUPNRRE(DFN,11,I,0),U)
.S ELGEDAT=$P(^AUPNRRE(DFN,11,I,0),U,2)
.S AUTHBDOS=$P(^ACHSF(DUZ(2),"D",DA,3),U)
.S AUTHEDOS=$P(^ACHSF(DUZ(2),"D",DA,3),U,2)
.I (ELGEDAT="")&(AUTHBDOS>ELGBDAT) S CT=CT+1 W ?65,"Y"
.I (ELGEDAT'="")&(AUTHBDOS>ELGBDAT)&(AUTHBDOS<ELGEDAT) S CT=CT+1 W ?65,"Y"
K ELGBDAT,ELGEDAT,AUTHBOS,AUTHEDOS,I,CT
Q
ACHSVUR1 ; IHS/ITSC/PMF - NO DESCRIPTION PROVIDED ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;routine created 9/11/00 to check eligibility changes
+3 ;
PRVTST ;EP from ACHSVUR
+1 ;TEST FOR PRIVATE INSURANCE ELIGIBLE DURING DATE OF SERVICE
+2 SET I=0
+3 SET CT=0
+4 FOR
SET I=$ORDER(^AUPNPRVT(DFN,11,I))
IF (I'?1N.N)!(CT=1)
QUIT
Begin DoDot:1
+5 SET ELGBDAT=$PIECE(^AUPNPRVT(DFN,11,I,0),U,6)
+6 SET ELGEDAT=$PIECE(^AUPNPRVT(DFN,11,I,0),U,7)
+7 SET AUTHBDOS=$PIECE(^ACHSF(DUZ(2),"D",DA,3),U)
+8 SET AUTHEDOS=$PIECE(^ACHSF(DUZ(2),"D",DA,3),U,2)
+9 IF (ELGEDAT="")&(AUTHBDOS>ELGBDAT)
SET CT=CT+1
WRITE ?65,"Y"
+10 IF (ELGEDAT'="")&(AUTHBDOS>ELGBDAT)&(AUTHBDOS<ELGEDAT)
SET CT=CT+1
WRITE ?65,"Y"
End DoDot:1
+11 KILL ELGBDAT,ELGEDAT,AUTHBOS,AUTHEDOS,I,CT
+12 QUIT
MCDTST ;EP from ACHSVUR
+1 ;TEST FOR MEDICAID INSURANCE ELIGIBLE DURING DATE OF SERVICE
+2 SET CT=0
+3 SET M=0
+4 SET M=$ORDER(^AUPNMCD("B",DFN,M))
IF '+M
QUIT
Begin DoDot:1
+5 SET MCDDFN=M
+6 QUIT
End DoDot:1
+7 SET I=0
+8 FOR
SET I=$ORDER(^AUPNMCD(MCDDFN,11,I))
IF (I'?1N.N)!(CT=1)
QUIT
Begin DoDot:1
+9 SET ELGBDAT=$PIECE(^AUPNMCD(MCDDFN,11,I,0),U)
+10 SET ELGEDAT=$PIECE(^AUPNMCD(MCDDFN,11,I,0),U,2)
+11 SET AUTHBDOS=$PIECE(^ACHSF(DUZ(2),"D",DA,3),U)
+12 SET AUTHEDOS=$PIECE(^ACHSF(DUZ(2),"D",DA,3),U,2)
+13 IF (ELGEDAT="")&(AUTHBDOS>ELGBDAT)
SET CT=CT+1
WRITE ?65,"Y"
+14 IF (ELGEDAT'="")&(AUTHBDOS>ELGBDAT)&(AUTHBDOS<ELGEDAT)
SET CT=CT+1
WRITE ?65,"Y"
End DoDot:1
+15 KILL ELGBDAT,ELGEDAT,AUTHBOS,AUTHEDOS,I,M,MCDDFN,CT
+16 QUIT
MCRTST ;EP from ACHSVUR
+1 ;TEST FOR MEDICARE INSURANCE ELIGIBLE DURING DATE OF SERVICE
+2 SET CT=0
+3 SET I=0
+4 FOR
SET I=$ORDER(^AUPNMCR(DFN,11,I))
IF (I'?1N.N)!(CT=1)
QUIT
Begin DoDot:1
+5 SET ELGBDAT=$PIECE(^AUPNMCR(DFN,11,I,0),U)
+6 SET ELGEDAT=$PIECE(^AUPNMCR(DFN,11,I,0),U,2)
+7 SET AUTHBDOS=$PIECE(^ACHSF(DUZ(2),"D",DA,3),U)
+8 SET AUTHEDOS=$PIECE(^ACHSF(DUZ(2),"D",DA,3),U,2)
+9 IF (ELGEDAT="")&(AUTHBDOS>ELGBDAT)
SET CT=CT+1
WRITE ?65,"Y"
+10 IF (ELGEDAT'="")&(AUTHBDOS>ELGBDAT)&(AUTHBDOS<ELGEDAT)
SET CT=CT+1
WRITE ?65,"Y"
End DoDot:1
+11 KILL ELGBDAT,ELGEDAT,AUTHBOS,AUTHEDOS,I,CT
+12 QUIT
RRETST ;EP from ACHSVUR
+1 ;TEST FOR RAILROAD INSURANCE ELIGIBLE DURING DATE OF SERVICE
+2 SET CT=0
+3 SET I=0
+4 FOR
SET I=$ORDER(^AUPNRRE(DFN,11,I))
IF (I'?1N.N)!(CT=1)
QUIT
Begin DoDot:1
+5 SET ELGBDAT=$PIECE(^AUPNRRE(DFN,11,I,0),U)
+6 SET ELGEDAT=$PIECE(^AUPNRRE(DFN,11,I,0),U,2)
+7 SET AUTHBDOS=$PIECE(^ACHSF(DUZ(2),"D",DA,3),U)
+8 SET AUTHEDOS=$PIECE(^ACHSF(DUZ(2),"D",DA,3),U,2)
+9 IF (ELGEDAT="")&(AUTHBDOS>ELGBDAT)
SET CT=CT+1
WRITE ?65,"Y"
+10 IF (ELGEDAT'="")&(AUTHBDOS>ELGBDAT)&(AUTHBDOS<ELGEDAT)
SET CT=CT+1
WRITE ?65,"Y"
End DoDot:1
+11 KILL ELGBDAT,ELGEDAT,AUTHBOS,AUTHEDOS,I,CT
+12 QUIT
