APCHS5A ; IHS/CMI/LAB - PART 5A OF APCHS5 -- SUMMARY PRODUCTION COMPONENTS ;
;;2.0;IHS PCC SUITE;**2,5,21**;MAY 14, 2009;Build 34
;
MAID ;ENTRY POINT
; MEDICAID
K APCHSITB
;<SETUP>
S APCHSPDN=0 F APCHSQ=0:0 S APCHSPDN=$O(^AUPNMCD("B",APCHSPAT,APCHSPDN)) Q:APCHSPDN="" D BMAID
;<DISPLAY>
S APCHSI=0 F APCHSQ=0:0 S APCHSI=$O(APCHSITB(APCHSI)) Q:APCHSI="" S APCHSJ=$O(APCHSITB(APCHSI,0)) S APCHSP=APCHSITB(APCHSI,APCHSJ) S APCHSPDN=$P(APCHSP,";",1),APCHSEDN=$P(APCHSP,";",2) D DMAID
;<CLEANUP>
MAIDX K APCHSCOV,APCHSDTL,APCHSDTN,APCHSDTS,APCHSEDN,APCHSI,APCHSIDN,APCHSINS,APCHSJ,APCHSN,APCHSPDN,APCHSUFF,Y,APCHSXDT,APCHSNM
Q
BMAID Q:'$D(^AUPNMCD(APCHSPDN))
S APCHSEDN=0 F APCHSQ=0:0 S APCHSEDN=$O(^AUPNMCD(APCHSPDN,11,APCHSEDN)) Q:'APCHSEDN S APCHSP=^(APCHSEDN,0) S APCHSI=$P(^AUPNMCD(APCHSPDN,0),U,4)_"-"_$P(APCHSP,U,3),APCHSJ=9999999-$P(APCHSP,U,1) S APCHSITB(APCHSI,APCHSJ)=APCHSPDN_";"_APCHSEDN
Q
DMAID ;
S APCHSN=^AUPNMCD(APCHSPDN,0)
S APCHSINS=$S($P(APCHSN,U,2):$P(^AUTNINS($P(APCHSN,U,2),0),U,1),1:"???") ;IHS/CMI/LAB - patch 6 prevent sbscr
S APCHSNM=^AUPNMCD(APCHSPDN,11,APCHSEDN,0)
S Y=$P(APCHSNM,U,1) X APCHSCVD S APCHSDTL=Y
;-- IHS/CMI/MAW add set of exp date variable, quit if not current
S (APCHSXDT,Y)=$P(APCHSNM,U,2) X APCHSCVD S APCHSDTN=Y
I APCHSXDT="" S APCHSXDT=9999999
Q:APCHSXDT<DT
;-- IHS/CMI/MAW end of mods
X APCHSCKP Q:$D(APCHSQIT) W:APCHSNPG "(Medicaid cont.)",!
S X=$P($G(^DIC(5,+$P(APCHSN,U,4),0)),U,2) W $S(X="":"??",1:X)," ",APCHSINS,?32,$P(APCHSN,U,3) ;IHS/ANMC/LJF 12/18/2002
;W $P(^DIC(5,$P(APCHSN,U,4),0),U,2)," ",APCHSINS,?32,$P(APCHSN,U,3)
W ?49,$P(APCHSNM,U,3),?54,APCHSDTL,?72,APCHSDTN,!
I $P(APCHSN,U,10)]"" W ?3,"Plan Name: ",$$VAL^XBDIQ1(9000004,APCHSPDN,.11),!
Q
MCARE ;ENTRY POINT
; MEDICARE
Q:'$D(^AUPNMCR(APCHSPAT))
S APCHSN=^AUPNMCR(APCHSPAT,0)
Q:'$D(^AUPNMCR(APCHSPAT,0)) ;CMI/LAB
S APCHSINS=$S($P(APCHSN,U,2):$P(^AUTNINS($P(APCHSN,U,2),0),U,1),1:"???") ;IHS/CMI/LAB - prevent sbscr
S APCHSUFF=$P(APCHSN,U,4) S:APCHSUFF]"" APCHSUFF=$P(^AUTTMCS(APCHSUFF,0),U,1)
K APCHSITB
S APCHSEDN=0 F APCHSQ=0:0 S APCHSEDN=$O(^AUPNMCR(APCHSPAT,11,APCHSEDN)) Q:APCHSEDN'=+APCHSEDN S APCHSP=^(APCHSEDN,0) S APCHSI=$P(APCHSN,U,2)_"-"_$P(APCHSP,U,3),APCHSJ=9999999-$P(APCHSP,U,1) S APCHSITB(APCHSI,APCHSJ)=APCHSPAT_";"_APCHSEDN
S APCHSI=0 F APCHSQ=0:0 S APCHSI=$O(APCHSITB(APCHSI)) Q:APCHSI="" S APCHSJ=$O(APCHSITB(APCHSI,0)) S APCHSP=APCHSITB(APCHSI,APCHSJ) S APCHSPDN=$P(APCHSP,";",1),APCHSEDN=$P(APCHSP,";",2) D DMCARE
W:$X'=0 !
Q
DMCARE ;
S APCHSNM=^AUPNMCR(APCHSPDN,11,APCHSEDN,0)
S Y=$P(APCHSNM,U,1) X APCHSCVD S APCHSDTL=Y
;-- IHS/CMI/MAW add set of exp date variable, quit if not current
S (APCHSXDT,Y)=$P(APCHSNM,U,2) X APCHSCVD S APCHSDTN=Y
I APCHSXDT="" S APCHSXDT=9999999
Q:APCHSXDT<DT
;-- IHS/CMI/MAW end of mods
X APCHSCKP Q:$D(APCHSQIT) W:APCHSNPG "(Medicare cont.)",!
;W APCHSINS,?32,$P(APCHSN,U,3),?44,APCHSUFF
W APCHSINS,?32,$$GETMCR^AGUTL(APCHSPAT),?44,APCHSUFF ;IHS/CMI/LAB NMCI
S APCHSCOV=$P(APCHSNM,U,3)
S APCHSDTS="" I APCHSCOV="B" S Y=$P(^AUPNPAT(APCHSPAT,0),U,4) X APCHSCVD S APCHSDTS=Y
X APCHSCKP Q:$D(APCHSQIT) W:APCHSNPG "(Medicare cont.)",!
W ?49,APCHSCOV,?54,APCHSDTL,?63,APCHSDTS,?72,APCHSDTN,!
K APCHSXDT,APCHSNM
Q
THIRD ;ENTRY POINT
; OTHER THIRD PARTY
Q:$O(^AUPNPRVT(APCHSPAT,11,0))=""
K APCHSITB
S APCHSIDN=0 F APCHSQ=0:0 S APCHSIDN=$O(^AUPNPRVT(APCHSPAT,11,APCHSIDN)) Q:APCHSIDN'=+APCHSIDN S APCHSP=^(APCHSIDN,0) S APCHSITB($P(APCHSP,U,1)_"-"_$P(APCHSP,U,3),9999999-$P(APCHSP,U,6))=APCHSIDN
;S APCHSI="" F APCHSQ=0:0 S APCHSI=$O(APCHSITB(APCHSI)) Q:APCHSI="" S APCHSJ=$O(APCHSITB(APCHSI,0)) S APCHSIDN=APCHSITB(APCHSI,APCHSJ) D DTHIRD
S APCHSI="" F APCHSQ=0:0 S APCHSI=$O(APCHSITB(APCHSI)) Q:APCHSI="" S APCHSJ="" F S APCHSJ=$O(APCHSITB(APCHSI,APCHSJ)) Q:APCHSJ="" S APCHSIDN=APCHSITB(APCHSI,APCHSJ) D DTHIRD
Q
DTHIRD S APCHSN=^AUPNPRVT(APCHSPAT,11,APCHSIDN,0)
Q:$P(APCHSN,U,1)=""
S APCHSINS=$P(^AUTNINS($P(APCHSN,U,1),0),U,1)
S Y=$P(APCHSN,U,6) X APCHSCVD S APCHSDTL=Y
;-- IHS/CMI/MAW add set of exp date variable, quit if not current
S (APCHSXDT,Y)=$P(APCHSN,U,7) X APCHSCVD S APCHSDTN=Y
I APCHSXDT="" S APCHSXDT=9999999
Q:APCHSXDT<DT
;-- IHS/CMI/MAW end of mods
X APCHSCKP Q:$D(APCHSQIT) W:APCHSNPG "(3rd party cont.)",!
;IHS/CMI/GRL policy number field of Private Insurance Eligible is obsolete. Per Adrian Lujan,
;following code looks at the Member Number field of Insurer multiple. If null, then get policy number
;from Policy Holder File
S $P(APCHSN,U,2)=$P($G(^AUPNPRVT(APCHSPAT,11,APCHSIDN,2)),U) ;member number
I $P($G(APCHSN),U,2)']"",$P(APCHSN,U,8) S $P(APCHSN,U,2)=$P($G(^AUPN3PPH($P(APCHSN,U,8),0)),U,4) ;policy number
;IHS/CMI/GRL end of patch
W APCHSINS,?32,$P(APCHSN,U,2),?49,$P(APCHSN,U,3),?54,APCHSDTL,?72,APCHSDTN,!
X APCHSCKP Q:$D(APCHSQIT) W:APCHSNPG "(3rd party cont.)",!
I $P(APCHSN,U,8) W ?32,"Coverage Type: ",$$VAL^XBDIQ1(9000003.1,$P(APCHSN,U,8),.05),!
K APCHSXDT
Q
RR ;EP
; RAILROAD RETIREMENT
Q:'$D(^AUPNRRE(APCHSPAT))
S APCHSN=^AUPNRRE(APCHSPAT,0)
S APCHSINS=$P(^AUTNINS($P(APCHSN,U,2),0),U,1)
S APCHSUFF=$P(APCHSN,U,3)
K APCHSITB
S APCHSEDN=0 F APCHSQ=0:0 S APCHSEDN=$O(^AUPNRRE(APCHSPAT,11,APCHSEDN)) Q:APCHSEDN'=+APCHSEDN S APCHSP=^(APCHSEDN,0) S APCHSI=$P(APCHSN,U,2)_"-"_$P(APCHSP,U,3),APCHSJ=9999999-$P(APCHSP,U,1) S APCHSITB(APCHSI,APCHSJ)=APCHSPAT_";"_APCHSEDN
S APCHSI=0 F APCHSQ=0:0 S APCHSI=$O(APCHSITB(APCHSI)) Q:APCHSI="" S APCHSJ=$O(APCHSITB(APCHSI,0)) S APCHSP=APCHSITB(APCHSI,APCHSJ) S APCHSPDN=$P(APCHSP,";",1),APCHSEDN=$P(APCHSP,";",2) D DRR
W:$X'=0 !
Q
DRR ;
S APCHSNM=^AUPNRRE(APCHSPDN,11,APCHSEDN,0)
S Y=$P(APCHSNM,U,1) X APCHSCVD S APCHSDTL=Y
;-- IHS/CMI/MAW add set of exp date variable, quit if not current
S (APCHSXDT,Y)=$P(APCHSNM,U,2) X APCHSCVD S APCHSDTN=Y
I APCHSXDT="" S APCHSXDT=9999999
Q:APCHSXDT<DT
;-- IHS/CMI/MAW end of mods
S APCHSCOV=$P(APCHSNM,U,3)
X APCHSCKP Q:$D(APCHSQIT) W:APCHSNPG "(Railroad Retirement cont.)",!
;W APCHSINS,?32,$P(APCHSN,U,4),?44,APCHSUFF
W APCHSINS,?32,$$GETRRE^AGUTL(APCHSPAT),?44,APCHSUFF
W ?49,APCHSCOV,?54,APCHSDTL,?72,APCHSDTN,!
K APCHSNM,APCHSXDT
Q
APCHS5A ; IHS/CMI/LAB - PART 5A OF APCHS5 -- SUMMARY PRODUCTION COMPONENTS ;
+1 ;;2.0;IHS PCC SUITE;**2,5,21**;MAY 14, 2009;Build 34
+2 ;
MAID ;ENTRY POINT
+1 ; MEDICAID
+2 KILL APCHSITB
+3 ;<SETUP>
+4 SET APCHSPDN=0
FOR APCHSQ=0:0
SET APCHSPDN=$ORDER(^AUPNMCD("B",APCHSPAT,APCHSPDN))
IF APCHSPDN=""
QUIT
DO BMAID
+5 ;<DISPLAY>
+6 SET APCHSI=0
FOR APCHSQ=0:0
SET APCHSI=$ORDER(APCHSITB(APCHSI))
IF APCHSI=""
QUIT
SET APCHSJ=$ORDER(APCHSITB(APCHSI,0))
SET APCHSP=APCHSITB(APCHSI,APCHSJ)
SET APCHSPDN=$PIECE(APCHSP,";",1)
SET APCHSEDN=$PIECE(APCHSP,";",2)
DO DMAID
+7 ;<CLEANUP>
MAIDX KILL APCHSCOV,APCHSDTL,APCHSDTN,APCHSDTS,APCHSEDN,APCHSI,APCHSIDN,APCHSINS,APCHSJ,APCHSN,APCHSPDN,APCHSUFF,Y,APCHSXDT,APCHSNM
+1 QUIT
BMAID IF '$DATA(^AUPNMCD(APCHSPDN))
QUIT
+1 SET APCHSEDN=0
FOR APCHSQ=0:0
SET APCHSEDN=$ORDER(^AUPNMCD(APCHSPDN,11,APCHSEDN))
IF 'APCHSEDN
QUIT
SET APCHSP=^(APCHSEDN,0)
SET APCHSI=$PIECE(^AUPNMCD(APCHSPDN,0),U,4)_"-"_$PIECE(APCHSP,U,3)
SET APCHSJ=9999999-$PIECE(APCHSP,U,1)
SET APCHSITB(APCHSI,APCHSJ)=APCHSPDN_";"_APCHSEDN
+2 QUIT
DMAID ;
+1 SET APCHSN=^AUPNMCD(APCHSPDN,0)
+2 ;IHS/CMI/LAB - patch 6 prevent sbscr
SET APCHSINS=$SELECT($PIECE(APCHSN,U,2):$PIECE(^AUTNINS($PIECE(APCHSN,U,2),0),U,1),1:"???")
+3 SET APCHSNM=^AUPNMCD(APCHSPDN,11,APCHSEDN,0)
+4 SET Y=$PIECE(APCHSNM,U,1)
XECUTE APCHSCVD
SET APCHSDTL=Y
+5 ;-- IHS/CMI/MAW add set of exp date variable, quit if not current
+6 SET (APCHSXDT,Y)=$PIECE(APCHSNM,U,2)
XECUTE APCHSCVD
SET APCHSDTN=Y
+7 IF APCHSXDT=""
SET APCHSXDT=9999999
+8 IF APCHSXDT<DT
QUIT
+9 ;-- IHS/CMI/MAW end of mods
+10 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
IF APCHSNPG
WRITE "(Medicaid cont.)",!
+11 ;IHS/ANMC/LJF 12/18/2002
SET X=$PIECE($GET(^DIC(5,+$PIECE(APCHSN,U,4),0)),U,2)
WRITE $SELECT(X="":"??",1:X)," ",APCHSINS,?32,$PIECE(APCHSN,U,3)
+12 ;W $P(^DIC(5,$P(APCHSN,U,4),0),U,2)," ",APCHSINS,?32,$P(APCHSN,U,3)
+13 WRITE ?49,$PIECE(APCHSNM,U,3),?54,APCHSDTL,?72,APCHSDTN,!
+14 IF $PIECE(APCHSN,U,10)]""
WRITE ?3,"Plan Name: ",$$VAL^XBDIQ1(9000004,APCHSPDN,.11),!
+15 QUIT
MCARE ;ENTRY POINT
+1 ; MEDICARE
+2 IF '$DATA(^AUPNMCR(APCHSPAT))
QUIT
+3 SET APCHSN=^AUPNMCR(APCHSPAT,0)
+4 ;CMI/LAB
IF '$DATA(^AUPNMCR(APCHSPAT,0))
QUIT
+5 ;IHS/CMI/LAB - prevent sbscr
SET APCHSINS=$SELECT($PIECE(APCHSN,U,2):$PIECE(^AUTNINS($PIECE(APCHSN,U,2),0),U,1),1:"???")
+6 SET APCHSUFF=$PIECE(APCHSN,U,4)
IF APCHSUFF]""
SET APCHSUFF=$PIECE(^AUTTMCS(APCHSUFF,0),U,1)
+7 KILL APCHSITB
+8 SET APCHSEDN=0
FOR APCHSQ=0:0
SET APCHSEDN=$ORDER(^AUPNMCR(APCHSPAT,11,APCHSEDN))
IF APCHSEDN'=+APCHSEDN
QUIT
SET APCHSP=^(APCHSEDN,0)
SET APCHSI=$PIECE(APCHSN,U,2)_"-"_$PIECE(APCHSP,U,3)
SET APCHSJ=9999999-$PIECE(APCHSP,U,1)
SET APCHSITB(APCHSI,APCHSJ)=APCHSPAT_";"_APCHSEDN
+9 SET APCHSI=0
FOR APCHSQ=0:0
SET APCHSI=$ORDER(APCHSITB(APCHSI))
IF APCHSI=""
QUIT
SET APCHSJ=$ORDER(APCHSITB(APCHSI,0))
SET APCHSP=APCHSITB(APCHSI,APCHSJ)
SET APCHSPDN=$PIECE(APCHSP,";",1)
SET APCHSEDN=$PIECE(APCHSP,";",2)
DO DMCARE
+10 IF $X'=0
WRITE !
+11 QUIT
DMCARE ;
+1 SET APCHSNM=^AUPNMCR(APCHSPDN,11,APCHSEDN,0)
+2 SET Y=$PIECE(APCHSNM,U,1)
XECUTE APCHSCVD
SET APCHSDTL=Y
+3 ;-- IHS/CMI/MAW add set of exp date variable, quit if not current
+4 SET (APCHSXDT,Y)=$PIECE(APCHSNM,U,2)
XECUTE APCHSCVD
SET APCHSDTN=Y
+5 IF APCHSXDT=""
SET APCHSXDT=9999999
+6 IF APCHSXDT<DT
QUIT
+7 ;-- IHS/CMI/MAW end of mods
+8 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
IF APCHSNPG
WRITE "(Medicare cont.)",!
+9 ;W APCHSINS,?32,$P(APCHSN,U,3),?44,APCHSUFF
+10 ;IHS/CMI/LAB NMCI
WRITE APCHSINS,?32,$$GETMCR^AGUTL(APCHSPAT),?44,APCHSUFF
+11 SET APCHSCOV=$PIECE(APCHSNM,U,3)
+12 SET APCHSDTS=""
IF APCHSCOV="B"
SET Y=$PIECE(^AUPNPAT(APCHSPAT,0),U,4)
XECUTE APCHSCVD
SET APCHSDTS=Y
+13 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
IF APCHSNPG
WRITE "(Medicare cont.)",!
+14 WRITE ?49,APCHSCOV,?54,APCHSDTL,?63,APCHSDTS,?72,APCHSDTN,!
+15 KILL APCHSXDT,APCHSNM
+16 QUIT
THIRD ;ENTRY POINT
+1 ; OTHER THIRD PARTY
+2 IF $ORDER(^AUPNPRVT(APCHSPAT,11,0))=""
QUIT
+3 KILL APCHSITB
+4 SET APCHSIDN=0
FOR APCHSQ=0:0
SET APCHSIDN=$ORDER(^AUPNPRVT(APCHSPAT,11,APCHSIDN))
IF APCHSIDN'=+APCHSIDN
QUIT
SET APCHSP=^(APCHSIDN,0)
SET APCHSITB($PIECE(APCHSP,U,1)_"-"_$PIECE(APCHSP,U,3),9999999-$PIECE(APCHSP,U,6))=APCHSIDN
+5 ;S APCHSI="" F APCHSQ=0:0 S APCHSI=$O(APCHSITB(APCHSI)) Q:APCHSI="" S APCHSJ=$O(APCHSITB(APCHSI,0)) S APCHSIDN=APCHSITB(APCHSI,APCHSJ) D DTHIRD
+6 SET APCHSI=""
FOR APCHSQ=0:0
SET APCHSI=$ORDER(APCHSITB(APCHSI))
IF APCHSI=""
QUIT
SET APCHSJ=""
FOR
SET APCHSJ=$ORDER(APCHSITB(APCHSI,APCHSJ))
IF APCHSJ=""
QUIT
SET APCHSIDN=APCHSITB(APCHSI,APCHSJ)
DO DTHIRD
+7 QUIT
DTHIRD SET APCHSN=^AUPNPRVT(APCHSPAT,11,APCHSIDN,0)
+1 IF $PIECE(APCHSN,U,1)=""
QUIT
+2 SET APCHSINS=$PIECE(^AUTNINS($PIECE(APCHSN,U,1),0),U,1)
+3 SET Y=$PIECE(APCHSN,U,6)
XECUTE APCHSCVD
SET APCHSDTL=Y
+4 ;-- IHS/CMI/MAW add set of exp date variable, quit if not current
+5 SET (APCHSXDT,Y)=$PIECE(APCHSN,U,7)
XECUTE APCHSCVD
SET APCHSDTN=Y
+6 IF APCHSXDT=""
SET APCHSXDT=9999999
+7 IF APCHSXDT<DT
QUIT
+8 ;-- IHS/CMI/MAW end of mods
+9 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
IF APCHSNPG
WRITE "(3rd party cont.)",!
+10 ;IHS/CMI/GRL policy number field of Private Insurance Eligible is obsolete. Per Adrian Lujan,
+11 ;following code looks at the Member Number field of Insurer multiple. If null, then get policy number
+12 ;from Policy Holder File
+13 ;member number
SET $PIECE(APCHSN,U,2)=$PIECE($GET(^AUPNPRVT(APCHSPAT,11,APCHSIDN,2)),U)
+14 ;policy number
IF $PIECE($GET(APCHSN),U,2)']""
IF $PIECE(APCHSN,U,8)
SET $PIECE(APCHSN,U,2)=$PIECE($GET(^AUPN3PPH($PIECE(APCHSN,U,8),0)),U,4)
+15 ;IHS/CMI/GRL end of patch
+16 WRITE APCHSINS,?32,$PIECE(APCHSN,U,2),?49,$PIECE(APCHSN,U,3),?54,APCHSDTL,?72,APCHSDTN,!
+17 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
IF APCHSNPG
WRITE "(3rd party cont.)",!
+18 IF $PIECE(APCHSN,U,8)
WRITE ?32,"Coverage Type: ",$$VAL^XBDIQ1(9000003.1,$PIECE(APCHSN,U,8),.05),!
+19 KILL APCHSXDT
+20 QUIT
RR ;EP
+1 ; RAILROAD RETIREMENT
+2 IF '$DATA(^AUPNRRE(APCHSPAT))
QUIT
+3 SET APCHSN=^AUPNRRE(APCHSPAT,0)
+4 SET APCHSINS=$PIECE(^AUTNINS($PIECE(APCHSN,U,2),0),U,1)
+5 SET APCHSUFF=$PIECE(APCHSN,U,3)
+6 KILL APCHSITB
+7 SET APCHSEDN=0
FOR APCHSQ=0:0
SET APCHSEDN=$ORDER(^AUPNRRE(APCHSPAT,11,APCHSEDN))
IF APCHSEDN'=+APCHSEDN
QUIT
SET APCHSP=^(APCHSEDN,0)
SET APCHSI=$PIECE(APCHSN,U,2)_"-"_$PIECE(APCHSP,U,3)
SET APCHSJ=9999999-$PIECE(APCHSP,U,1)
SET APCHSITB(APCHSI,APCHSJ)=APCHSPAT_";"_APCHSEDN
+8 SET APCHSI=0
FOR APCHSQ=0:0
SET APCHSI=$ORDER(APCHSITB(APCHSI))
IF APCHSI=""
QUIT
SET APCHSJ=$ORDER(APCHSITB(APCHSI,0))
SET APCHSP=APCHSITB(APCHSI,APCHSJ)
SET APCHSPDN=$PIECE(APCHSP,";",1)
SET APCHSEDN=$PIECE(APCHSP,";",2)
DO DRR
+9 IF $X'=0
WRITE !
+10 QUIT
DRR ;
+1 SET APCHSNM=^AUPNRRE(APCHSPDN,11,APCHSEDN,0)
+2 SET Y=$PIECE(APCHSNM,U,1)
XECUTE APCHSCVD
SET APCHSDTL=Y
+3 ;-- IHS/CMI/MAW add set of exp date variable, quit if not current
+4 SET (APCHSXDT,Y)=$PIECE(APCHSNM,U,2)
XECUTE APCHSCVD
SET APCHSDTN=Y
+5 IF APCHSXDT=""
SET APCHSXDT=9999999
+6 IF APCHSXDT<DT
QUIT
+7 ;-- IHS/CMI/MAW end of mods
+8 SET APCHSCOV=$PIECE(APCHSNM,U,3)
+9 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
IF APCHSNPG
WRITE "(Railroad Retirement cont.)",!
+10 ;W APCHSINS,?32,$P(APCHSN,U,4),?44,APCHSUFF
+11 WRITE APCHSINS,?32,$$GETRRE^AGUTL(APCHSPAT),?44,APCHSUFF
+12 WRITE ?49,APCHSCOV,?54,APCHSDTL,?72,APCHSDTN,!
+13 KILL APCHSNM,APCHSXDT
+14 QUIT
