- 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
