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
