- 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
