AGMCRP3 ; IHS/ASDS/EFG - PRINT ALPHA LIST OF MEDICARE/RAILROAD HOLDERS ;
;;7.1;PATIENT REGISTRATION;**14**;AUG 25,2005;Build 1
;
;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
;
S AGIO=IO,AG("HAT")=""
PTS ;
S DIR(0)="S^B:ALL BENEFICIARIES;A:ACTIVE PATIENTS ONLY;D:DECEASED AND INACTIVE PATIENTS ONLY"
S DIR("A")="SELECT DESIRED ACCOUNTS"
D ^DIR K DIR
S AGPTS=Y
Q:$D(DTOUT)!(Y="^")!(Y="/.,")!(Y="^^")
DEV S %ZIS="OPQ" D ^%ZIS I POP S IOP=ION D ^%ZIS Q
G:'$D(IO("Q")) START K IO("Q") I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
X ^%ZOSF("UCI") S ZTRTN="START^AGMCRP",ZTUCI=Y,ZTIO="",ZTDESC="Alpha List MEDICARE/RR Holders for "_$P(^AUTTLOC(DUZ(2),0),U,2)_".",AGQIO=IO F G="AGQIO" S ZTSAVE(G)=""
D ^%ZTLOAD G:'$D(ZTSK) DEV K AG,AGIO,AGQIO,G,ZTDESC,ZTIO,ZTRTN,ZTSK,ZTUCI D ^%ZISC
Q
START ;EP - From TaskMan.
S (DFN,AGTOT)=0 K ^TMP($J)
F S DFN=$O(^AUPNMCR(DFN)) Q:+DFN<1 D
.S AGFLAG=0
.;if there is an HRN for this person and data in VA PATIENT
.I $D(^AUPNPAT(DFN,41,DUZ(2))),$D(^DPT(DFN,0)) D
..I AGPTS="A" D ;active people only
...I $P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,3)="",$P($G(^DPT(DFN,.35)),U)="" S AGFLAG=1
..I AGPTS="D" D ;deceased/inactive only
...I $P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,3)'=""!($P($G(^DPT(DFN,.35)),U)'="") S AGFLAG=1
..I AGPTS="B" S AGFLAG=1
..I AGFLAG S ^TMP($J,$P(^DPT(DFN,0),U),DFN)="",AGTOT=AGTOT+1
I $D(AGQIO) F AGZ("I")=1:1 S IOP=AGQIO D ^%ZIS Q:'POP H 30
X ^%ZOSF("UCI") S X="UCI: "_$P(Y,",",1)
D CTR^AG
S AGUCI=X,AGPGPG=0,AG("LOC")=$P(^DIC(4,DUZ(2),0),U),AG("USR")=$P(^VA(200,DUZ,0),U),AG("USRLOC")=AG("USR")_$J("",40-($L(AG("LOC"))\2)-$L(AG("USR")))_AG("LOC"),AGBM=IOSL-10
I $D(AGIO),AGIO=IO S AGBM=IOSL-4
K AG("LOC"),AG("USR") D LINES^AG,NOW^AG S AGNM="",X="as of "_AGTIME D CTR^AG S AGTIME=X U IO D HDR
F AGZ("I")=1:1 S AGNM=$O(^TMP($J,AGNM)) Q:AGNM="" S DFN=0 F AGZ("I")=1:1 S DFN=$O(^TMP($J,AGNM,DFN)) Q:DFN="" D PRINT I $Y>AGBM D RTRN^AG G END1:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D HDR
END W !!!,"TOTAL MEDICARE/RAILROAD RET. PATIENTS: ",AGTOT K AG("HAT") D RTRN^AG W $$S^AGVDF("IOF")
END1 D ^%ZISC K ^TMP($J),A,AG,AGBM,AGDOB,AGIO,AGTIME,DA,AG("DENT"),DIC,DFN,DR,G,AGL,I,AG("LKDATA"),AG("LKPRINT"),AGNEW,AGNM,AGPCC,AGPGPG,AGTOT,AGUCI,AG("USRLOC"),X,Y D:$D(ZTQUEUED) KILL^%ZTLOAD
Q
PRINT ;Print a Patient's MEDICARE/RAILROAD file.
;this is to make sure they are Part B somewhere
S (I,AGCFLAG)=""
F S I=$O(^AUPNMCR(DFN,11,I)) Q:I="" D
.S AGCOV=$P($G(^AUPNMCR(DFN,11,I,0)),U,3)
.I AGCOV="B" S AGCFLAG=1
Q:AGCFLAG'=1
S DIC=2,DA=DFN,DR=.03 D ^AGDICLK K AGDOB S:$D(AG("LKPRINT")) AGDOB=AG("LKPRINT") W "(REG) ",AGNM,?36,$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2),?49 G RR:^TMP($J,AGNM,DFN)="R"
;S DIC=9000003,DA=DFN,DR=.03 D ^AGDICLK W:$D(AG("LKPRINT")) AG("LKPRINT") S DR=.04 D ^AGDICLK W:$D(AG("LKPRINT")) AG("LKPRINT") W ?64 W:$D(AGDOB) AGDOB ;IHS/OIT/NKD AG*7.1*14
W $$GETMCR^AGUTL(DFN) W ?64 W:$D(AGDOB) AGDOB
S DIC=9000003,DR=2101,DA=DFN D ^AGDICLK K AGMCRNM I $D(AG("LKPRINT")),AG("LKPRINT")]"" S AGMCRNM=AG("LKPRINT")
S DR=2102 D ^AGDICLK K AGMCRDB I $D(AG("LKPRINT")),AG("LKPRINT")]"" S AGMCRDB=AG("LKPRINT")
I $D(AGMCRNM)!$D(AGMCRDB) W !,"(MCR) " W:$D(AGMCRNM) AGMCRNM W:$D(AGMCRDB) ?64,AGMCRDB K AGMCRNM,AGMCRDB
S DIC=9000003.11,DA=DFN
F S I=$O(^AUPNMCR(DFN,11,I)) Q:I="" D
.S AGCOV=$P($G(^AUPNMCR(DFN,11,I,0)),U,3)
.Q:AGCOV'="B"
.S DR=.01,AG("DRENT1")=I D ^AGDICLK
.W !,"(MCR) " W:$D(AG("LKPRINT")) ?14,AG("LKPRINT")
.S DR=.03,AG("DRENT1")=I D ^AGDICLK W:$D(AG("LKPRINT")) ?37,AG("LKPRINT")
.S DR=.02,AG("DRENT1")=I D ^AGDICLK W:$D(AG("LKPRINT")) ?49,AG("LKPRINT")
W !,AG("-"),!
Q
;RR S DIC=9000005,DA=DFN,DR=.03 D ^AGDICLK W:$D(AG("LKPRINT")) AG("LKPRINT") S DR=.04 D ^AGDICLK W:$D(AG("LKPRINT")) AG("LKPRINT") W ?64 W:$D(AGDOB) AGDOB ;IHS/OIT/NKD AG*7.1*14
RR W $$GETRRE^AGUTL(DFN) W ?64 W:$D(AGDOB) AGDOB
S DIC=9000005,DR=2101,DA=DFN D ^AGDICLK K AGRRNM I $D(AG("LKPRINT")),AG("LKPRINT")]"" S AGRRNM=AG("LKPRINT")
S DR=2102 D ^AGDICLK K AGRRDB I $D(AG("LKPRINT")),AG("LKPRINT")]"" S AGRRDB=AG("LKPRINT")
I $D(AGRRNM)!$D(AGRRDB) W !,"(RR) " W:$D(AGRRNM) AGRRNM W:$D(AGRRDB) ?64,AGRRDB K AGRRNM,AGRRDB
S DIC=9000005.11,DA=DFN
F I=0:0 S I=$O(^AUPNRRE(DFN,11,I)) Q:I="" D
.S DR=.01,AG("DRENT1")=I D ^AGDICLK W !,"(RR) " W:$D(AG("LKPRINT")) ?14,AG("LKPRINT")
.S DR=.03,AG("DRENT1")=I D ^AGDICLK W:$D(AG("LKPRINT")) ?37,AG("LKPRINT")
.S DR=.02,AG("DRENT1")=I D ^AGDICLK W:$D(AG("LKPRINT")) ?49,AG("LKPRINT")
W !,AG("-"),!
Q
HDR S AGPGPG=AGPGPG+1
W $$S^AGVDF("IOF"),!!,AG("USRLOC"),?72,"page ",AGPGPG
W !?17,"REGISTERED PATIENTS - MEDICARE/RAILROAD ACCOUNTS"
W !,AGUCI,!,AGTIME
W !!?17,"REPORT CONTAINS "_$S(AGPTS="B":"ALL BENEFICIARIES",AGPTS="A":"ATIENTS ONLY",AGPTS="D":"DECEASED AND INACTIVE PATIENTS ONLY")
W !!," NAME",?36,"CHART #",?49,"NUMBER",!,"(TYPE)",?14,"ELIG DATE END DATE",?64,"DATE OF BIRTH"
W !,AG("="),!
Q
AGMCRP3 ; IHS/ASDS/EFG - PRINT ALPHA LIST OF MEDICARE/RAILROAD HOLDERS ;
+1 ;;7.1;PATIENT REGISTRATION;**14**;AUG 25,2005;Build 1
+2 ;
+3 ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
+4 ;
+5 SET AGIO=IO
SET AG("HAT")=""
PTS ;
+1 SET DIR(0)="S^B:ALL BENEFICIARIES;A:ACTIVE PATIENTS ONLY;D:DECEASED AND INACTIVE PATIENTS ONLY"
+2 SET DIR("A")="SELECT DESIRED ACCOUNTS"
+3 DO ^DIR
KILL DIR
+4 SET AGPTS=Y
+5 IF $DATA(DTOUT)!(Y="^")!(Y="/.,")!(Y="^^")
QUIT
DEV SET %ZIS="OPQ"
DO ^%ZIS
IF POP
SET IOP=ION
DO ^%ZIS
QUIT
+1 IF '$DATA(IO("Q"))
GOTO START
KILL IO("Q")
IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+2 XECUTE ^%ZOSF("UCI")
SET ZTRTN="START^AGMCRP"
SET ZTUCI=Y
SET ZTIO=""
SET ZTDESC="Alpha List MEDICARE/RR Holders for "_$PIECE(^AUTTLOC(DUZ(2),0),U,2)_"."
SET AGQIO=IO
FOR G="AGQIO"
SET ZTSAVE(G)=""
+3 DO ^%ZTLOAD
IF '$DATA(ZTSK)
GOTO DEV
KILL AG,AGIO,AGQIO,G,ZTDESC,ZTIO,ZTRTN,ZTSK,ZTUCI
DO ^%ZISC
+4 QUIT
START ;EP - From TaskMan.
+1 SET (DFN,AGTOT)=0
KILL ^TMP($JOB)
+2 FOR
SET DFN=$ORDER(^AUPNMCR(DFN))
IF +DFN<1
QUIT
Begin DoDot:1
+3 SET AGFLAG=0
+4 ;if there is an HRN for this person and data in VA PATIENT
+5 IF $DATA(^AUPNPAT(DFN,41,DUZ(2)))
IF $DATA(^DPT(DFN,0))
Begin DoDot:2
+6 ;active people only
IF AGPTS="A"
Begin DoDot:3
+7 IF $PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,3)=""
IF $PIECE($GET(^DPT(DFN,.35)),U)=""
SET AGFLAG=1
End DoDot:3
+8 ;deceased/inactive only
IF AGPTS="D"
Begin DoDot:3
+9 IF $PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,3)'=""!($PIECE($GET(^DPT(DFN,.35)),U)'="")
SET AGFLAG=1
End DoDot:3
+10 IF AGPTS="B"
SET AGFLAG=1
+11 IF AGFLAG
SET ^TMP($JOB,$PIECE(^DPT(DFN,0),U),DFN)=""
SET AGTOT=AGTOT+1
End DoDot:2
End DoDot:1
+12 IF $DATA(AGQIO)
FOR AGZ("I")=1:1
SET IOP=AGQIO
DO ^%ZIS
IF 'POP
QUIT
HANG 30
+13 XECUTE ^%ZOSF("UCI")
SET X="UCI: "_$PIECE(Y,",",1)
+14 DO CTR^AG
+15 SET AGUCI=X
SET AGPGPG=0
SET AG("LOC")=$PIECE(^DIC(4,DUZ(2),0),U)
SET AG("USR")=$PIECE(^VA(200,DUZ,0),U)
SET AG("USRLOC")=AG("USR")_$JUSTIFY("",40-($LENGTH(AG("LOC"))\2)-$LENGTH(AG("USR")))_AG("LOC")
SET AGBM=IOSL-10
+16 IF $DATA(AGIO)
IF AGIO=IO
SET AGBM=IOSL-4
+17 KILL AG("LOC"),AG("USR")
DO LINES^AG
DO NOW^AG
SET AGNM=""
SET X="as of "_AGTIME
DO CTR^AG
SET AGTIME=X
USE IO
DO HDR
+18 FOR AGZ("I")=1:1
SET AGNM=$ORDER(^TMP($JOB,AGNM))
IF AGNM=""
QUIT
SET DFN=0
FOR AGZ("I")=1:1
SET DFN=$ORDER(^TMP($JOB,AGNM,DFN))
IF DFN=""
QUIT
DO PRINT
IF $Y>AGBM
DO RTRN^AG
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
GOTO END1
DO HDR
END WRITE !!!,"TOTAL MEDICARE/RAILROAD RET. PATIENTS: ",AGTOT
KILL AG("HAT")
DO RTRN^AG
WRITE $$S^AGVDF("IOF")
END1 DO ^%ZISC
KILL ^TMP($JOB),A,AG,AGBM,AGDOB,AGIO,AGTIME,DA,AG("DENT"),DIC,DFN,DR,G,AGL,I,AG("LKDATA"),AG("LKPRINT"),AGNEW,AGNM,AGPCC,AGPGPG,AGTOT,AGUCI,AG("USRLOC"),X,Y
IF $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
+1 QUIT
PRINT ;Print a Patient's MEDICARE/RAILROAD file.
+1 ;this is to make sure they are Part B somewhere
+2 SET (I,AGCFLAG)=""
+3 FOR
SET I=$ORDER(^AUPNMCR(DFN,11,I))
IF I=""
QUIT
Begin DoDot:1
+4 SET AGCOV=$PIECE($GET(^AUPNMCR(DFN,11,I,0)),U,3)
+5 IF AGCOV="B"
SET AGCFLAG=1
End DoDot:1
+6 IF AGCFLAG'=1
QUIT
+7 SET DIC=2
SET DA=DFN
SET DR=.03
DO ^AGDICLK
KILL AGDOB
IF $DATA(AG("LKPRINT"))
SET AGDOB=AG("LKPRINT")
WRITE "(REG) ",AGNM,?36,$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2),?49
IF ^TMP($JOB,AGNM,DFN)="R"
GOTO RR
+8 ;S DIC=9000003,DA=DFN,DR=.03 D ^AGDICLK W:$D(AG("LKPRINT")) AG("LKPRINT") S DR=.04 D ^AGDICLK W:$D(AG("LKPRINT")) AG("LKPRINT") W ?64 W:$D(AGDOB) AGDOB ;IHS/OIT/NKD AG*7.1*14
+9 WRITE $$GETMCR^AGUTL(DFN)
WRITE ?64
IF $DATA(AGDOB)
WRITE AGDOB
+10 SET DIC=9000003
SET DR=2101
SET DA=DFN
DO ^AGDICLK
KILL AGMCRNM
IF $DATA(AG("LKPRINT"))
IF AG("LKPRINT")]""
SET AGMCRNM=AG("LKPRINT")
+11 SET DR=2102
DO ^AGDICLK
KILL AGMCRDB
IF $DATA(AG("LKPRINT"))
IF AG("LKPRINT")]""
SET AGMCRDB=AG("LKPRINT")
+12 IF $DATA(AGMCRNM)!$DATA(AGMCRDB)
WRITE !,"(MCR) "
IF $DATA(AGMCRNM)
WRITE AGMCRNM
IF $DATA(AGMCRDB)
WRITE ?64,AGMCRDB
KILL AGMCRNM,AGMCRDB
+13 SET DIC=9000003.11
SET DA=DFN
+14 FOR
SET I=$ORDER(^AUPNMCR(DFN,11,I))
IF I=""
QUIT
Begin DoDot:1
+15 SET AGCOV=$PIECE($GET(^AUPNMCR(DFN,11,I,0)),U,3)
+16 IF AGCOV'="B"
QUIT
+17 SET DR=.01
SET AG("DRENT1")=I
DO ^AGDICLK
+18 WRITE !,"(MCR) "
IF $DATA(AG("LKPRINT"))
WRITE ?14,AG("LKPRINT")
+19 SET DR=.03
SET AG("DRENT1")=I
DO ^AGDICLK
IF $DATA(AG("LKPRINT"))
WRITE ?37,AG("LKPRINT")
+20 SET DR=.02
SET AG("DRENT1")=I
DO ^AGDICLK
IF $DATA(AG("LKPRINT"))
WRITE ?49,AG("LKPRINT")
End DoDot:1
+21 WRITE !,AG("-"),!
+22 QUIT
+23 ;RR S DIC=9000005,DA=DFN,DR=.03 D ^AGDICLK W:$D(AG("LKPRINT")) AG("LKPRINT") S DR=.04 D ^AGDICLK W:$D(AG("LKPRINT")) AG("LKPRINT") W ?64 W:$D(AGDOB) AGDOB ;IHS/OIT/NKD AG*7.1*14
RR WRITE $$GETRRE^AGUTL(DFN)
WRITE ?64
IF $DATA(AGDOB)
WRITE AGDOB
+1 SET DIC=9000005
SET DR=2101
SET DA=DFN
DO ^AGDICLK
KILL AGRRNM
IF $DATA(AG("LKPRINT"))
IF AG("LKPRINT")]""
SET AGRRNM=AG("LKPRINT")
+2 SET DR=2102
DO ^AGDICLK
KILL AGRRDB
IF $DATA(AG("LKPRINT"))
IF AG("LKPRINT")]""
SET AGRRDB=AG("LKPRINT")
+3 IF $DATA(AGRRNM)!$DATA(AGRRDB)
WRITE !,"(RR) "
IF $DATA(AGRRNM)
WRITE AGRRNM
IF $DATA(AGRRDB)
WRITE ?64,AGRRDB
KILL AGRRNM,AGRRDB
+4 SET DIC=9000005.11
SET DA=DFN
+5 FOR I=0:0
SET I=$ORDER(^AUPNRRE(DFN,11,I))
IF I=""
QUIT
Begin DoDot:1
+6 SET DR=.01
SET AG("DRENT1")=I
DO ^AGDICLK
WRITE !,"(RR) "
IF $DATA(AG("LKPRINT"))
WRITE ?14,AG("LKPRINT")
+7 SET DR=.03
SET AG("DRENT1")=I
DO ^AGDICLK
IF $DATA(AG("LKPRINT"))
WRITE ?37,AG("LKPRINT")
+8 SET DR=.02
SET AG("DRENT1")=I
DO ^AGDICLK
IF $DATA(AG("LKPRINT"))
WRITE ?49,AG("LKPRINT")
End DoDot:1
+9 WRITE !,AG("-"),!
+10 QUIT
HDR SET AGPGPG=AGPGPG+1
+1 WRITE $$S^AGVDF("IOF"),!!,AG("USRLOC"),?72,"page ",AGPGPG
+2 WRITE !?17,"REGISTERED PATIENTS - MEDICARE/RAILROAD ACCOUNTS"
+3 WRITE !,AGUCI,!,AGTIME
+4 WRITE !!?17,"REPORT CONTAINS "_$SELECT(AGPTS="B":"ALL BENEFICIARIES",AGPTS="A":"ATIENTS ONLY",AGPTS="D":"DECEASED AND INACTIVE PATIENTS ONLY")
+5 WRITE !!," NAME",?36,"CHART #",?49,"NUMBER",!,"(TYPE)",?14,"ELIG DATE END DATE",?64,"DATE OF BIRTH"
+6 WRITE !,AG("="),!
+7 QUIT
