ACMRLU ; IHS/TUCSON/TMJ - GEN RETR UTILITIES ;
;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996
;
RZERO(V,L) ;ep right zero fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=V_"0"
Q V
LZERO(V,L) ;left zero fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V="0"_V
Q V
LBLK(V,L) ;left blank fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=" "_V
Q V
MCR(P,D) ;is patient medicare eligible on this date
NEW ACMMIFN,ACMFLG
S ACMFLG=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 ACMMIFN=0 F S ACMMIFN=$O(^AUPNMCR(P,11,ACMMIFN)) Q:ACMMIFN'=+ACMMIFN D
.Q:$P(^AUPNMCR(P,11,ACMMIFN,0),U)>D
.I $P(^AUPNMCR(P,11,ACMMIFN,0),U,2)]"",$P(^(0),U,2)<D Q
.S ACMFLG=1
.Q
MCRX ;
Q ACMFLG
;
MCD(P,D) ;
NEW ACMMIFN,ACMNIFN,ACMFLG
S ACMFLG=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 ACMMIFN=0 F S ACMMIFN=$O(^AUPNMCD("B",P,ACMMIFN)) Q:ACMMIFN'=+ACMMIFN D
.Q:'$D(^AUPNMCD(ACMMIFN,11))
.S ACMNIFN=0 F S ACMNIFN=$O(^AUPNMCD(ACMMIFN,11,ACMNIFN)) Q:ACMNIFN'=+ACMNIFN D
..Q:ACMNIFN>D
..I $P(^AUPNMCD(ACMMIFN,11,ACMNIFN,0),U,2)]"",$P(^(0),U,2)<D Q
..S ACMFLG=1
..Q
.Q
;
MCDX ;
Q ACMFLG
;
PI(P,D) ;
NEW ACMMIFN,ACMFLG
S ACMFLG=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 ACMMIFN=0 F S ACMMIFN=$O(^AUPNPRVT(P,11,ACMMIFN)) Q:ACMMIFN'=+ACMMIFN D
.Q:$P(^AUPNPRVT(P,11,ACMMIFN,0),U)=""
.S ACMNAME=$P(^AUPNPRVT(P,11,ACMMIFN,0),U) Q:ACMNAME=""
.Q:$P(^AUTNINS(ACMNAME,0),U)["AHCCCS"
.Q:$P(^AUPNPRVT(P,11,ACMMIFN,0),U,6)>D
.I $P(^AUPNPRVT(P,11,ACMMIFN,0),U,7)]"",$P(^(0),U,7)<D Q
.S ACMFLG=1
.Q
PIX ;
Q ACMFLG
ACMRLU ; IHS/TUCSON/TMJ - GEN RETR UTILITIES ;
+1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996
+2 ;
RZERO(V,L) ;ep right zero fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=V_"0"
+3 QUIT V
LZERO(V,L) ;left zero fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V="0"_V
+3 QUIT V
LBLK(V,L) ;left blank fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=" "_V
+3 QUIT V
MCR(P,D) ;is patient medicare eligible on this date
+1 NEW ACMMIFN,ACMFLG
+2 SET ACMFLG=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 ACMMIFN=0
FOR
SET ACMMIFN=$ORDER(^AUPNMCR(P,11,ACMMIFN))
IF ACMMIFN'=+ACMMIFN
QUIT
Begin DoDot:1
+9 IF $PIECE(^AUPNMCR(P,11,ACMMIFN,0),U)>D
QUIT
+10 IF $PIECE(^AUPNMCR(P,11,ACMMIFN,0),U,2)]""
IF $PIECE(^(0),U,2)<D
QUIT
+11 SET ACMFLG=1
+12 QUIT
End DoDot:1
MCRX ;
+1 QUIT ACMFLG
+2 ;
MCD(P,D) ;
+1 NEW ACMMIFN,ACMNIFN,ACMFLG
+2 SET ACMFLG=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 ACMMIFN=0
FOR
SET ACMMIFN=$ORDER(^AUPNMCD("B",P,ACMMIFN))
IF ACMMIFN'=+ACMMIFN
QUIT
Begin DoDot:1
+8 IF '$DATA(^AUPNMCD(ACMMIFN,11))
QUIT
+9 SET ACMNIFN=0
FOR
SET ACMNIFN=$ORDER(^AUPNMCD(ACMMIFN,11,ACMNIFN))
IF ACMNIFN'=+ACMNIFN
QUIT
Begin DoDot:2
+10 IF ACMNIFN>D
QUIT
+11 IF $PIECE(^AUPNMCD(ACMMIFN,11,ACMNIFN,0),U,2)]""
IF $PIECE(^(0),U,2)<D
QUIT
+12 SET ACMFLG=1
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 ;
MCDX ;
+1 QUIT ACMFLG
+2 ;
PI(P,D) ;
+1 NEW ACMMIFN,ACMFLG
+2 SET ACMFLG=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 ACMMIFN=0
FOR
SET ACMMIFN=$ORDER(^AUPNPRVT(P,11,ACMMIFN))
IF ACMMIFN'=+ACMMIFN
QUIT
Begin DoDot:1
+9 IF $PIECE(^AUPNPRVT(P,11,ACMMIFN,0),U)=""
QUIT
+10 SET ACMNAME=$PIECE(^AUPNPRVT(P,11,ACMMIFN,0),U)
IF ACMNAME=""
QUIT
+11 IF $PIECE(^AUTNINS(ACMNAME,0),U)["AHCCCS"
QUIT
+12 IF $PIECE(^AUPNPRVT(P,11,ACMMIFN,0),U,6)>D
QUIT
+13 IF $PIECE(^AUPNPRVT(P,11,ACMMIFN,0),U,7)]""
IF $PIECE(^(0),U,7)<D
QUIT
+14 SET ACMFLG=1
+15 QUIT
End DoDot:1
PIX ;
+1 QUIT ACMFLG
