AGMCRP5 ; IHS/ASDS/EFG - PRINT ALPHA LIST OF MEDICARE A&B HOLDERS ;
;;7.1;PATIENT REGISTRATION;**4,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^AGMCRP5",ZTUCI=Y,ZTIO="",ZTDESC="Alpha List MEDICARE A & B 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
S AGSTOP=""
F S AGNM=$O(^TMP($J,AGNM)) Q:AGNM="" D Q:AGSTOP
.S DFN=0
.F S DFN=$O(^TMP($J,AGNM,DFN)) Q:DFN="" D Q:AGSTOP
..D PRINT
..I $Y>AGBM D
...D RTRN^AG
...I $D(DUOUT)!$D(DTOUT)!$D(DFOUT) S AGSTOP=1 G END1
...D HDR
I 'AGSTOP D END
Q
END W !!!,"TOTAL MEDICARE A & B 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 file.
;this is to make sure they are Part A and B somewhere
S (I,AGCFLAGA,AGCFLAGB)="" ;SET A FLAG AND B FLAG
F S I=$O(^AUPNMCR(DFN,11,I)) Q:I="" D
.S AGCOV=""
.S AGCOV=$P($G(^AUPNMCR(DFN,11,I,0)),U,3)
.I AGCOV="A" S AGCFLAGA=1
.I AGCOV="B" S AGCFLAGB=1
Q:AGCFLAGA'=1!(AGCFLAGB'=1)
W "(REG) ",AGNM,?36,$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
W ?64,$$GET1^DIQ(2,DFN_",",.03)
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")
;W !,"(MCR) " W AGMCRNM,?49,$$GET1^DIQ(9000003,DFN_",",.03)_$$GET1^DIQ(9000003,DFN_",",.04) W ?64,AGMCRDB K AGMCRNM,AGMCRDB ;IHS/OIT/NKD AG*7.1*14
W !,"(MCR) " W AGMCRNM,?49,$$GETMCR^AGUTL(DFN) W ?64,AGMCRDB K AGMCRNM,AGMCRDB
S DIC=9000003.11,DA=DFN
S I=""
F S I=$O(^AUPNMCR(DFN,11,I)) Q:I="" D
.S AGCOV=$P($G(^AUPNMCR(DFN,11,I,0)),U,3)
.Q:AGCOV="D"
.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
HDR S AGPGPG=AGPGPG+1
W $$S^AGVDF("IOF"),!!,AG("USRLOC"),?72,"page ",AGPGPG
W !?17,"REGISTERED PATIENTS - MEDICARE A & B ACCOUNTS"
W !,AGUCI,!,AGTIME
W !!?17,"REPORT CONTAINS "_$S(AGPTS="B":"ALL BENEFICIARIES",AGPTS="A":"ACTIVE PATIENTS ONLY",AGPTS="D":"DECEASED AND INACTIVE PATIENTS ONLY")
W !!," NAME",?36,"CHART #",?49,"NUMBER",!,"(TYPE)",?14,"ELIG DATE",?34,"COVERAGE",?49,"ELIG END DATE",?64,"DATE OF BIRTH"
W !,AG("="),!
Q
AGMCRP5 ; IHS/ASDS/EFG - PRINT ALPHA LIST OF MEDICARE A&B HOLDERS ;
+1 ;;7.1;PATIENT REGISTRATION;**4,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^AGMCRP5"
SET ZTUCI=Y
SET ZTIO=""
SET ZTDESC="Alpha List MEDICARE A & B 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 SET AGSTOP=""
+19 FOR
SET AGNM=$ORDER(^TMP($JOB,AGNM))
IF AGNM=""
QUIT
Begin DoDot:1
+20 SET DFN=0
+21 FOR
SET DFN=$ORDER(^TMP($JOB,AGNM,DFN))
IF DFN=""
QUIT
Begin DoDot:2
+22 DO PRINT
+23 IF $Y>AGBM
Begin DoDot:3
+24 DO RTRN^AG
+25 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
SET AGSTOP=1
GOTO END1
+26 DO HDR
End DoDot:3
End DoDot:2
IF AGSTOP
QUIT
End DoDot:1
IF AGSTOP
QUIT
+27 IF 'AGSTOP
DO END
+28 QUIT
END WRITE !!!,"TOTAL MEDICARE A & B 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 file.
+1 ;this is to make sure they are Part A and B somewhere
+2 ;SET A FLAG AND B FLAG
SET (I,AGCFLAGA,AGCFLAGB)=""
+3 FOR
SET I=$ORDER(^AUPNMCR(DFN,11,I))
IF I=""
QUIT
Begin DoDot:1
+4 SET AGCOV=""
+5 SET AGCOV=$PIECE($GET(^AUPNMCR(DFN,11,I,0)),U,3)
+6 IF AGCOV="A"
SET AGCFLAGA=1
+7 IF AGCOV="B"
SET AGCFLAGB=1
End DoDot:1
+8 IF AGCFLAGA'=1!(AGCFLAGB'=1)
QUIT
+9 WRITE "(REG) ",AGNM,?36,$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
+10 WRITE ?64,$$GET1^DIQ(2,DFN_",",.03)
+11 SET DIC=9000003
SET DR=2101
SET DA=DFN
DO ^AGDICLK
KILL AGMCRNM
IF $DATA(AG("LKPRINT"))
IF AG("LKPRINT")]""
SET AGMCRNM=AG("LKPRINT")
+12 SET DR=2102
DO ^AGDICLK
KILL AGMCRDB
IF $DATA(AG("LKPRINT"))
IF AG("LKPRINT")]""
SET AGMCRDB=AG("LKPRINT")
+13 ;W !,"(MCR) " W AGMCRNM,?49,$$GET1^DIQ(9000003,DFN_",",.03)_$$GET1^DIQ(9000003,DFN_",",.04) W ?64,AGMCRDB K AGMCRNM,AGMCRDB ;IHS/OIT/NKD AG*7.1*14
+14 WRITE !,"(MCR) "
WRITE AGMCRNM,?49,$$GETMCR^AGUTL(DFN)
WRITE ?64,AGMCRDB
KILL AGMCRNM,AGMCRDB
+15 SET DIC=9000003.11
SET DA=DFN
+16 SET I=""
+17 FOR
SET I=$ORDER(^AUPNMCR(DFN,11,I))
IF I=""
QUIT
Begin DoDot:1
+18 SET AGCOV=$PIECE($GET(^AUPNMCR(DFN,11,I,0)),U,3)
+19 IF AGCOV="D"
QUIT
+20 SET DR=.01
SET AG("DRENT1")=I
DO ^AGDICLK
+21 WRITE !,"(MCR) "
IF $DATA(AG("LKPRINT"))
WRITE ?14,AG("LKPRINT")
+22 SET DR=.03
SET AG("DRENT1")=I
DO ^AGDICLK
IF $DATA(AG("LKPRINT"))
WRITE ?37,AG("LKPRINT")
+23 SET DR=.02
SET AG("DRENT1")=I
DO ^AGDICLK
IF $DATA(AG("LKPRINT"))
WRITE ?49,AG("LKPRINT")
End DoDot:1
+24 WRITE !,AG("-"),!
+25 QUIT
HDR SET AGPGPG=AGPGPG+1
+1 WRITE $$S^AGVDF("IOF"),!!,AG("USRLOC"),?72,"page ",AGPGPG
+2 WRITE !?17,"REGISTERED PATIENTS - MEDICARE A & B ACCOUNTS"
+3 WRITE !,AGUCI,!,AGTIME
+4 WRITE !!?17,"REPORT CONTAINS "_$SELECT(AGPTS="B":"ALL BENEFICIARIES",AGPTS="A":"ACTIVE PATIENTS ONLY",AGPTS="D":"DECEASED AND INACTIVE PATIENTS ONLY")
+5 WRITE !!," NAME",?36,"CHART #",?49,"NUMBER",!,"(TYPE)",?14,"ELIG DATE",?34,"COVERAGE",?49,"ELIG END DATE",?64,"DATE OF BIRTH"
+6 WRITE !,AG("="),!
+7 QUIT
