- ACDRLU ;IHS/ADC/EDE/KML - GEN RETR UTILITIES;
- ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- ;
- ;
- COMPV(C) ;
- K:$L(C)>14!($L(C)<2)!'(C'?1P.E) C K C
- Q
- MCR(P,D) ;is patient medicare eligible on this date
- NEW ACDMIFN,ACDFLG
- S ACDFLG=0
- I '$D(^DPT(P,0)) G MCRX
- I $P(^DPT(P,0),U,19) G MCRX
- I '$D(^AUPNPAT(P,0)) G MCRX
- I '$D(^AUPNMCR(P,11)) G MCRX
- I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCRX
- S ACDMIFN=0 F S ACDMIFN=$O(^AUPNMCR(P,11,ACDMIFN)) Q:ACDMIFN'=+ACDMIFN D
- .Q:$P(^AUPNMCR(P,11,ACDMIFN,0),U)>D
- .I $P(^AUPNMCR(P,11,ACDMIFN,0),U,2)]"",$P(^(0),U,2)<D Q
- .S ACDFLG=1
- .Q
- MCRX ;
- Q ACDFLG
- ;
- MCD(P,D) ;
- NEW ACDMIFN,ACDNIFN,ACDFLG
- S ACDFLG=0
- I '$D(^DPT(P,0)) G MCRX
- I $P(^DPT(P,0),U,19) G MCRX
- I '$D(^AUPNPAT(P,0)) G MCDX
- I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCRX
- S ACDMIFN=0 F S ACDMIFN=$O(^AUPNMCD("B",P,ACDMIFN)) Q:ACDMIFN'=+ACDMIFN D
- .Q:'$D(^AUPNMCD(ACDMIFN,11))
- .S ACDNIFN=0 F S ACDNIFN=$O(^AUPNMCD(ACDMIFN,11,ACDNIFN)) Q:ACDNIFN'=+ACDNIFN D
- ..Q:ACDNIFN>D
- ..I $P(^AUPNMCD(ACDMIFN,11,ACDNIFN,0),U,2)]"",$P(^(0),U,2)<D Q
- ..S ACDFLG=1
- ..Q
- .Q
- ;
- MCDX ;
- Q ACDFLG
- ;
- PI(P,D) ;
- NEW ACDMIFN,ACDFLG
- S ACDFLG=0
- I '$D(^DPT(P,0)) G PIX
- I $P(^DPT(P,0),U,19) G PIX
- I '$D(^AUPNPAT(P,0)) G PIX
- I '$D(^AUPNPRVT(P,11)) G PIX
- I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G PIX
- S ACDMIFN=0 F S ACDMIFN=$O(^AUPNPRVT(P,11,ACDMIFN)) Q:ACDMIFN'=+ACDMIFN D
- .Q:$P(^AUPNPRVT(P,11,ACDMIFN,0),U)=""
- .S ACDNAME=$P(^AUPNPRVT(P,11,ACDMIFN,0),U) Q:ACDNAME=""
- .Q:$P(^AUTNINS(ACDNAME,0),U)["AHCCCS"
- .Q:$P(^AUPNPRVT(P,11,ACDMIFN,0),U,6)>D
- .I $P(^AUPNPRVT(P,11,ACDMIFN,0),U,7)]"",$P(^(0),U,7)<D Q
- .S ACDFLG=1
- .Q
- PIX ;
- Q ACDFLG
- ANYINS(P,D) ;EP - return 1 or 0 if patient has any insurance
- NEW ACDA
- S ACDA=0
- S ACDA=$$MCR(P,D) I ACDA Q ACDA
- S ACDA=$$MCD(P,D) I ACDA Q ACDA
- S ACDA=$$PI(P,D)
- Q ACDA
- ;
- Q
- ACDRLU ;IHS/ADC/EDE/KML - GEN RETR UTILITIES;
- +1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- +2 ;
- +3 ;
- COMPV(C) ;
- +1 IF $LENGTH(C)>14!($LENGTH(C)<2)!'(C'?1P.E)
- KILL C
- KILL C
- +2 QUIT
- MCR(P,D) ;is patient medicare eligible on this date
- +1 NEW ACDMIFN,ACDFLG
- +2 SET ACDFLG=0
- +3 IF '$DATA(^DPT(P,0))
- GOTO MCRX
- +4 IF $PIECE(^DPT(P,0),U,19)
- GOTO MCRX
- +5 IF '$DATA(^AUPNPAT(P,0))
- GOTO MCRX
- +6 IF '$DATA(^AUPNMCR(P,11))
- GOTO MCRX
- +7 IF $DATA(^DPT(P,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<D
- GOTO MCRX
- +8 SET ACDMIFN=0
- FOR
- SET ACDMIFN=$ORDER(^AUPNMCR(P,11,ACDMIFN))
- IF ACDMIFN'=+ACDMIFN
- QUIT
- Begin DoDot:1
- +9 IF $PIECE(^AUPNMCR(P,11,ACDMIFN,0),U)>D
- QUIT
- +10 IF $PIECE(^AUPNMCR(P,11,ACDMIFN,0),U,2)]""
- IF $PIECE(^(0),U,2)<D
- QUIT
- +11 SET ACDFLG=1
- +12 QUIT
- End DoDot:1
- MCRX ;
- +1 QUIT ACDFLG
- +2 ;
- MCD(P,D) ;
- +1 NEW ACDMIFN,ACDNIFN,ACDFLG
- +2 SET ACDFLG=0
- +3 IF '$DATA(^DPT(P,0))
- GOTO MCRX
- +4 IF $PIECE(^DPT(P,0),U,19)
- GOTO MCRX
- +5 IF '$DATA(^AUPNPAT(P,0))
- GOTO MCDX
- +6 IF $DATA(^DPT(P,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<D
- GOTO MCRX
- +7 SET ACDMIFN=0
- FOR
- SET ACDMIFN=$ORDER(^AUPNMCD("B",P,ACDMIFN))
- IF ACDMIFN'=+ACDMIFN
- QUIT
- Begin DoDot:1
- +8 IF '$DATA(^AUPNMCD(ACDMIFN,11))
- QUIT
- +9 SET ACDNIFN=0
- FOR
- SET ACDNIFN=$ORDER(^AUPNMCD(ACDMIFN,11,ACDNIFN))
- IF ACDNIFN'=+ACDNIFN
- QUIT
- Begin DoDot:2
- +10 IF ACDNIFN>D
- QUIT
- +11 IF $PIECE(^AUPNMCD(ACDMIFN,11,ACDNIFN,0),U,2)]""
- IF $PIECE(^(0),U,2)<D
- QUIT
- +12 SET ACDFLG=1
- +13 QUIT
- End DoDot:2
- +14 QUIT
- End DoDot:1
- +15 ;
- MCDX ;
- +1 QUIT ACDFLG
- +2 ;
- PI(P,D) ;
- +1 NEW ACDMIFN,ACDFLG
- +2 SET ACDFLG=0
- +3 IF '$DATA(^DPT(P,0))
- GOTO PIX
- +4 IF $PIECE(^DPT(P,0),U,19)
- GOTO PIX
- +5 IF '$DATA(^AUPNPAT(P,0))
- GOTO PIX
- +6 IF '$DATA(^AUPNPRVT(P,11))
- GOTO PIX
- +7 IF $DATA(^DPT(P,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<D
- GOTO PIX
- +8 SET ACDMIFN=0
- FOR
- SET ACDMIFN=$ORDER(^AUPNPRVT(P,11,ACDMIFN))
- IF ACDMIFN'=+ACDMIFN
- QUIT
- Begin DoDot:1
- +9 IF $PIECE(^AUPNPRVT(P,11,ACDMIFN,0),U)=""
- QUIT
- +10 SET ACDNAME=$PIECE(^AUPNPRVT(P,11,ACDMIFN,0),U)
- IF ACDNAME=""
- QUIT
- +11 IF $PIECE(^AUTNINS(ACDNAME,0),U)["AHCCCS"
- QUIT
- +12 IF $PIECE(^AUPNPRVT(P,11,ACDMIFN,0),U,6)>D
- QUIT
- +13 IF $PIECE(^AUPNPRVT(P,11,ACDMIFN,0),U,7)]""
- IF $PIECE(^(0),U,7)<D
- QUIT
- +14 SET ACDFLG=1
- +15 QUIT
- End DoDot:1
- PIX ;
- +1 QUIT ACDFLG
- ANYINS(P,D) ;EP - return 1 or 0 if patient has any insurance
- +1 NEW ACDA
- +2 SET ACDA=0
- +3 SET ACDA=$$MCR(P,D)
- IF ACDA
- QUIT ACDA
- +4 SET ACDA=$$MCD(P,D)
- IF ACDA
- QUIT ACDA
- +5 SET ACDA=$$PI(P,D)
- +6 QUIT ACDA
- +7 ;
- +8 QUIT
