AGELUP5 ;IHS/ASDS/EFG - UPDATE ELIGIBILITY FROM FILE
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
R(AG) ;process railroad retirement
I '$G(AG("DFN")) D FP
Q:'AG("DFN")
Q:$G(^TMP($J,"AGELUP",AG("DFN")))
S ^TMP($J,"AGELUP",AG("DFN"))=1
Q:AG("FNBR")'?9N
K AG1,AG2,AGSAME
I $D(^AUPNRRE(AG("DFN"))) D MCRY
Q:$G(AGSAME)
I $G(AGAUTO)'="A" D
.D HEAD^AGELUP6
.I '$D(^AUPNRRE(AG("DFN"))) D MCRN
.D MDISP
.D PEND^AGELUP6
I $G(AGAUTO)="A" D
.S AGACT="F"
.U IO(0) W ","
Q
FP ;find patient in rpms
S AG("DFN")=$O(^DPT("SSN",AG("FSSN"),0))
Q
MCRY ;if railroad coverage
S (AGMNM,AG1(1))=$P($G(^AUPNRRE(AG("DFN"),21)),"^",1)
S AGMDOB=$P($G(^AUPNRRE(AG("DFN"),21)),"^",2)
S AG1(2)=AGMDOB
S (AGMNBR,AG1(3))=$P(^AUPNRRE(AG("DFN"),0),"^",4)
S AGMSFX=$P(^AUPNRRE(AG("DFN"),0),"^",3)
S (AGMSFX,AG1(4))=$P($G(^AUTTRRP(+AGMSFX,0)),"^",1)
S (AGMESD,AGMEED,AGMCVT)=""
S DA=0 F S DA=$O(^AUPNRRE(AG("DFN"),11,DA)) Q:'DA D
.S AGDT=$P(^AUPNRRE(AG("DFN"),11,DA,0),"^",1),AGCOV=$P(^(0),"^",3)
.S AG1("DT",AGDT,AGCOV)=^AUPNRRE(AG("DFN"),11,DA,0)
K AGFL
D DFL
S:'$D(AGFL) AGSAME=1
Q
MCRN ;no railroad coverage in rpms
S AG1(1)="NO ELIGIBILITY ON FILE"
F I=2:1:4 S AG1(I)=""
D DFL
Q
DFL ;set descrepency flags
K AGFL
S AG2(1)=$G(AG("FNM"))
S:AG2(1)'=$G(AGMNM) AGFL(1)=1
S AG2(2)=$G(AG("FDOB"))
S:AG2(2)'=$G(AGMDOB) AGFL(2)=1
S AG2(3)=$G(AG("FNBR"))
S:AG2(3)'=$G(AGMNBR) AGFL(3)=1
S AG2(4)=$G(AG("FSFX"))
S:AG2(4)'=$G(AGMSFX) AGFL(4)=1
N I,J
S I=0 F S I=$O(AG("DT",I)) Q:'I D
.S J=0 F S J=$O(AG("DT",I,J)) Q:J="" D
..I $G(AG1("DT",I,J))'=AG("DT",I,J) S AGFL(5)=1
S I=0 F S I=$O(AG1("DT",I)) Q:'I D
.S J=0 F S J=$O(AG1("DT",I,J)) Q:J="" D
..I $G(AG("DT",I,J))'=AG1("DT",I,J) S AGFL(5)=1
Q
MDISP ;display medicare info
F I=1:1:4 D
.W !,$P($T(@I),";;",2)
.W ":"
.W ?12
.W:$G(AGFL(I)) $$S^AGVDF("RVN")
.W:I'=2 AG1(I)
.W:I=2 $$FMTE^XLFDT(AG1(I),5)
.W:$G(AGFL(I)) $$S^AGVDF("RVF")
.W ?45
.W:I'=2 AG2(I)
.W:I=2 $$FMTE^XLFDT(AG2(I),5)
W !
S AG1=0,AGCNT=0
K AGLINE
F S AG1=$O(AG1("DT",AG1)) Q:'AG1 D
.S AGCVT=0
.F S AGCVT=$O(AG1("DT",AG1,AGCVT)) Q:AGCVT="" D
..S AGCNT=AGCNT+1
..S AGLINE(AGCNT)=AG1("DT",AG1,AGCVT)
S AG2=0,AGCNT=0
F S AG2=$O(AG("DT",AG2)) Q:'AG2 D
.S AGCVT=0 F S AGCVT=$O(AG("DT",AG2,AGCVT)) Q:AGCVT="" D
..S AGCNT=AGCNT+1
..S $P(AGLINE(AGCNT),"*",2)=AG("DT",AG2,AGCVT)
..S:$P(AGLINE(AGCNT),"*",1)="" $P(AGLINE(AGCNT),"*",1)="^^"
S I=0,AGCNT=0
F S I=$O(AGLINE(I)) Q:'I D
.S AGLINE(I)=$TR(AGLINE(I),"*","^")
.W !,"START DATE: "
.W ?12,$$FMTE^XLFDT($P(AGLINE(I),"^",1),5)
.W ?45,$$FMTE^XLFDT($P(AGLINE(I),"^",4),5)
.W !,"END DATE: "
.W ?12,$$FMTE^XLFDT($P(AGLINE(I),"^",2),5)
.W ?45,$$FMTE^XLFDT($P(AGLINE(I),"^",5),5)
.W !,"COV TYPE: "
.W ?12,$P(AGLINE(I),"^",3)
.W ?45,$P(AGLINE(I),"^",6)
Q
1 ;;MCR NAME
2 ;;MCR DOB
3 ;;MCR NUMBER
4 ;;SFX
AGELUP5 ;IHS/ASDS/EFG - UPDATE ELIGIBILITY FROM FILE
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
R(AG) ;process railroad retirement
+1 IF '$GET(AG("DFN"))
DO FP
+2 IF 'AG("DFN")
QUIT
+3 IF $GET(^TMP($JOB,"AGELUP",AG("DFN")))
QUIT
+4 SET ^TMP($JOB,"AGELUP",AG("DFN"))=1
+5 IF AG("FNBR")'?9N
QUIT
+6 KILL AG1,AG2,AGSAME
+7 IF $DATA(^AUPNRRE(AG("DFN")))
DO MCRY
+8 IF $GET(AGSAME)
QUIT
+9 IF $GET(AGAUTO)'="A"
Begin DoDot:1
+10 DO HEAD^AGELUP6
+11 IF '$DATA(^AUPNRRE(AG("DFN")))
DO MCRN
+12 DO MDISP
+13 DO PEND^AGELUP6
End DoDot:1
+14 IF $GET(AGAUTO)="A"
Begin DoDot:1
+15 SET AGACT="F"
+16 USE IO(0)
WRITE ","
End DoDot:1
+17 QUIT
FP ;find patient in rpms
+1 SET AG("DFN")=$ORDER(^DPT("SSN",AG("FSSN"),0))
+2 QUIT
MCRY ;if railroad coverage
+1 SET (AGMNM,AG1(1))=$PIECE($GET(^AUPNRRE(AG("DFN"),21)),"^",1)
+2 SET AGMDOB=$PIECE($GET(^AUPNRRE(AG("DFN"),21)),"^",2)
+3 SET AG1(2)=AGMDOB
+4 SET (AGMNBR,AG1(3))=$PIECE(^AUPNRRE(AG("DFN"),0),"^",4)
+5 SET AGMSFX=$PIECE(^AUPNRRE(AG("DFN"),0),"^",3)
+6 SET (AGMSFX,AG1(4))=$PIECE($GET(^AUTTRRP(+AGMSFX,0)),"^",1)
+7 SET (AGMESD,AGMEED,AGMCVT)=""
+8 SET DA=0
FOR
SET DA=$ORDER(^AUPNRRE(AG("DFN"),11,DA))
IF 'DA
QUIT
Begin DoDot:1
+9 SET AGDT=$PIECE(^AUPNRRE(AG("DFN"),11,DA,0),"^",1)
SET AGCOV=$PIECE(^(0),"^",3)
+10 SET AG1("DT",AGDT,AGCOV)=^AUPNRRE(AG("DFN"),11,DA,0)
End DoDot:1
+11 KILL AGFL
+12 DO DFL
+13 IF '$DATA(AGFL)
SET AGSAME=1
+14 QUIT
MCRN ;no railroad coverage in rpms
+1 SET AG1(1)="NO ELIGIBILITY ON FILE"
+2 FOR I=2:1:4
SET AG1(I)=""
+3 DO DFL
+4 QUIT
DFL ;set descrepency flags
+1 KILL AGFL
+2 SET AG2(1)=$GET(AG("FNM"))
+3 IF AG2(1)'=$GET(AGMNM)
SET AGFL(1)=1
+4 SET AG2(2)=$GET(AG("FDOB"))
+5 IF AG2(2)'=$GET(AGMDOB)
SET AGFL(2)=1
+6 SET AG2(3)=$GET(AG("FNBR"))
+7 IF AG2(3)'=$GET(AGMNBR)
SET AGFL(3)=1
+8 SET AG2(4)=$GET(AG("FSFX"))
+9 IF AG2(4)'=$GET(AGMSFX)
SET AGFL(4)=1
+10 NEW I,J
+11 SET I=0
FOR
SET I=$ORDER(AG("DT",I))
IF 'I
QUIT
Begin DoDot:1
+12 SET J=0
FOR
SET J=$ORDER(AG("DT",I,J))
IF J=""
QUIT
Begin DoDot:2
+13 IF $GET(AG1("DT",I,J))'=AG("DT",I,J)
SET AGFL(5)=1
End DoDot:2
End DoDot:1
+14 SET I=0
FOR
SET I=$ORDER(AG1("DT",I))
IF 'I
QUIT
Begin DoDot:1
+15 SET J=0
FOR
SET J=$ORDER(AG1("DT",I,J))
IF J=""
QUIT
Begin DoDot:2
+16 IF $GET(AG("DT",I,J))'=AG1("DT",I,J)
SET AGFL(5)=1
End DoDot:2
End DoDot:1
+17 QUIT
MDISP ;display medicare info
+1 FOR I=1:1:4
Begin DoDot:1
+2 WRITE !,$PIECE($TEXT(@I),";;",2)
+3 WRITE ":"
+4 WRITE ?12
+5 IF $GET(AGFL(I))
WRITE $$S^AGVDF("RVN")
+6 IF I'=2
WRITE AG1(I)
+7 IF I=2
WRITE $$FMTE^XLFDT(AG1(I),5)
+8 IF $GET(AGFL(I))
WRITE $$S^AGVDF("RVF")
+9 WRITE ?45
+10 IF I'=2
WRITE AG2(I)
+11 IF I=2
WRITE $$FMTE^XLFDT(AG2(I),5)
End DoDot:1
+12 WRITE !
+13 SET AG1=0
SET AGCNT=0
+14 KILL AGLINE
+15 FOR
SET AG1=$ORDER(AG1("DT",AG1))
IF 'AG1
QUIT
Begin DoDot:1
+16 SET AGCVT=0
+17 FOR
SET AGCVT=$ORDER(AG1("DT",AG1,AGCVT))
IF AGCVT=""
QUIT
Begin DoDot:2
+18 SET AGCNT=AGCNT+1
+19 SET AGLINE(AGCNT)=AG1("DT",AG1,AGCVT)
End DoDot:2
End DoDot:1
+20 SET AG2=0
SET AGCNT=0
+21 FOR
SET AG2=$ORDER(AG("DT",AG2))
IF 'AG2
QUIT
Begin DoDot:1
+22 SET AGCVT=0
FOR
SET AGCVT=$ORDER(AG("DT",AG2,AGCVT))
IF AGCVT=""
QUIT
Begin DoDot:2
+23 SET AGCNT=AGCNT+1
+24 SET $PIECE(AGLINE(AGCNT),"*",2)=AG("DT",AG2,AGCVT)
+25 IF $PIECE(AGLINE(AGCNT),"*",1)=""
SET $PIECE(AGLINE(AGCNT),"*",1)="^^"
End DoDot:2
End DoDot:1
+26 SET I=0
SET AGCNT=0
+27 FOR
SET I=$ORDER(AGLINE(I))
IF 'I
QUIT
Begin DoDot:1
+28 SET AGLINE(I)=$TRANSLATE(AGLINE(I),"*","^")
+29 WRITE !,"START DATE: "
+30 WRITE ?12,$$FMTE^XLFDT($PIECE(AGLINE(I),"^",1),5)
+31 WRITE ?45,$$FMTE^XLFDT($PIECE(AGLINE(I),"^",4),5)
+32 WRITE !,"END DATE: "
+33 WRITE ?12,$$FMTE^XLFDT($PIECE(AGLINE(I),"^",2),5)
+34 WRITE ?45,$$FMTE^XLFDT($PIECE(AGLINE(I),"^",5),5)
+35 WRITE !,"COV TYPE: "
+36 WRITE ?12,$PIECE(AGLINE(I),"^",3)
+37 WRITE ?45,$PIECE(AGLINE(I),"^",6)
End DoDot:1
+38 QUIT
1 ;;MCR NAME
2 ;;MCR DOB
3 ;;MCR NUMBER
4 ;;SFX
