- 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
