AGAGERP3 ; VNGT/IHS/DLS - Patient Age Specific Report ; April 29, 2010
;;7.1;PATIENT REGISTRATION;**8,9,12,14**;AUG 25, 2005;Build 1
;
;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
;
Q
PRTMEDC ; Print Medicare Records
N PAGENO,LINECT,ESCAPE,PATNAM,PATIEN,MCRNUM,AGTOTAL,X
S PAGENO=0,ESCAPE=0
D MRHDR^AGAGERP2
S PATNAM=""
F S PATNAM=$O(^TMP("AGAGERP",$J,PATNAM)) Q:(PATNAM="")!(ESCAPE) D
. S PATIEN=""
. F S PATIEN=$O(^TMP("AGAGERP",$J,PATNAM,PATIEN)) Q:PATIEN="" D
. . S MCRNUM=""
. . F S MCRNUM=$O(^TMP("AGAGERP",$J,PATNAM,PATIEN,MCRNUM)) Q:MCRNUM="" D
. . . N CHRTNO,ADDR1,ADDR2,ADDR3,CITY,ST,ZIP,AGE,DOB,LASTUPD,COVERAGE,MCR,STABB
. . . N MNUMB,MSUFF,RNUMB,RPREF,COVNO
. . . S CHRTNO=$P($G(^AUPNPAT(PATIEN,41,DUZ(2),0)),U,2)
. . . S ADDR1=$$GET1^DIQ(2,PATIEN,.111)
. . . S ADDR2=$$GET1^DIQ(2,PATIEN,.112)
. . . S ADDR3=$$GET1^DIQ(2,PATIEN,.113)
. . . S CITY=$$GET1^DIQ(2,PATIEN,.114)
. . . S STABB=$$GET1^DIQ(2,PATIEN,.115,"I")
. . . S ST=$$GET1^DIQ(5,STABB,1)
. . . S ZIP=$$GET1^DIQ(2,PATIEN,.116)
. . . N Y S Y=$$GET1^DIQ(2,PATIEN,.03,"I") D DD^%DT S DOB=Y
. . . S AGE=$$GET1^DIQ(9000001,PATIEN,1102.98)
. . . S LASTUPD=$$GET1^DIQ(9000001,PATIEN,.03)
. . . S MCR=$$GET1^DIQ(9000003,MCRNUM,.14)
. . . S MNUMB=$$GET1^DIQ(9000003,MCRNUM,.03)
. . . S RNUMB=$$GET1^DIQ(9000005,MCRNUM,.04)
. . . S COVERAGE=""
. . . S COVNO=1
. . . I $G(MNUMB)'="" D MCOV^AGAGERP2
. . . I $G(RNUMB)'="" D RCOV^AGAGERP2
. . . I $$HASMBI^AGUTL(PATIEN),$$HASELIG^AGEDERR2(PATIEN)["MCR" D MCOV^AGAGERP2 ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
. . . I $$HASMBI^AGUTL(PATIEN),$$HASELIG^AGEDERR2(PATIEN)["RRE" D RCOV^AGAGERP2 ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
. . . S:$D(COVERAGE) COVERAGE=$P(COVERAGE,"/D",1),COVERAGE=$P(COVERAGE,"D",1) ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
. . . S MSUFF=$$GET1^DIQ(9000003,MCRNUM,.04)
. . . S RPREF=$$GET1^DIQ(9000005,MCRNUM,.03)
. . . W !,PATNAM," (",CHRTNO,")("
. . . I AGE["MOS" W AGE,")"
. . . I AGE'["MOS" W +AGE,")"
. . . ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2 - START OLD CODE
. . . ;I MNUMB'="" W ?47,"M=",MNUMB I MSUFF'="" W "-",MSUFF
. . . ;I RNUMB'="",MNUMB="" W ?47,"R=",RPREF,RNUMB
. . . ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2 - END OLD CODE - START NEW CODE
. . . I $$HASMBI^AGUTL(PATIEN) W ?47,$S($$HASELIG^AGEDERR2(PATIEN)["MCR":"M=",$$HASELIG^AGEDERR2(PATIEN)["RRE":"R=",1:"M="),$$GETMBI^AUPNMBI(PATIEN,$$DT^XLFDT)
. . . E I MNUMB'="" W ?47,"M=",MNUMB I MSUFF'="" W "-",MSUFF
. . . E I RNUMB'="",MNUMB="" W ?47,"R=",RPREF,RNUMB
. . . ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2 - END NEW CODE
. . . I $P(COVERAGE,"/",COVNO)'="" W ?69,"PART ",$P(COVERAGE,"/",COVNO) S COVNO=COVNO+1
. . . W !,?10,ADDR1
. . . ;I RNUMB'="",MNUMB'="" W ?47,"R=",RPREF,RNUMB ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
. . . I $$HASMBI^AGUTL(PATIEN),$$HASELIG^AGEDERR2(PATIEN)["MCR",$$HASELIG^AGEDERR2(PATIEN)["RRE" W ?47,"R=",$$GETMBI^AUPNMBI(PATIEN,$$DT^XLFDT) ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
. . . E I RNUMB'="",MNUMB'="" W ?47,"R=",RPREF,RNUMB ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
. . . I $P(COVERAGE,"/",COVNO)'="" W ?69,"PART ",$P(COVERAGE,"/",COVNO) S COVNO=COVNO+1
. . . I $G(ADDR2)'="" W !,?10,ADDR2 I $P(COVERAGE,"/",COVNO)'="" W ?69,"PART ",$P(COVERAGE,"/",COVNO) S COVNO=COVNO+1
. . . I $G(ADDR3)'="" W !,?10,ADDR3 I $P(COVERAGE,"/",COVNO)'="" W ?69,"PART ",$P(COVERAGE,"/",COVNO) S COVNO=COVNO+1
. . . W !,?10,CITY," ",ST," ",ZIP I $P(COVERAGE,"/",COVNO)'="" W ?69,"PART ",$P(COVERAGE,"/",COVNO) S COVNO=COVNO+1
. . . W !,"(MCR) ",MCR
. . . W !,LASTUPD
. . . W !,AGLINE("DASH") S LINECT=LINECT+7
. . . I $E(IOST)="C",$Y>(IOSL-5) K DIR D RTRN^AG S ESCAPE=X=U D:'ESCAPE MRHDR^AGAGERP2
. . . I $E(IOST)'="C",$Y>(IOSL-17) W !! D MRHDR^AGAGERP2
. . . S AGTOTAL=$G(AGTOTAL)+1
W !,"TOTAL RECORDS:",?20,$G(AGTOTAL),!!
I $E(IOST)="C",PATNAM="" K DIR D RTRN^AG
I $E(IOST)'="C" D CLOSE^%ZISH(IO)
Q
;
PRTMEDD ; Print Medicaid Records
N PAGENO,LINECT,ESCAPE,PATNAM,PATIEN,MCDNUM,AGTOTAL,X
S PAGENO=0,ESCAPE=0
D MDHDR^AGAGERP2
S PATNAM=""
F S PATNAM=$O(^TMP("AGAGERP",$J,PATNAM)) Q:(PATNAM="")!(ESCAPE) D
. S PATIEN=""
. F S PATIEN=$O(^TMP("AGAGERP",$J,PATNAM,PATIEN)) Q:(PATIEN="")!(ESCAPE) D
. . S MCDNUM=""
. . F S MCDNUM=$O(^TMP("AGAGERP",$J,PATNAM,PATIEN,MCDNUM)) Q:(MCDNUM="")!(ESCAPE) D
. . . N CHRTNO,ADDR1,ADDR2,ADDR3,CITY,ST,ZIP,DOB,LASTUPD,COVERAGE,MCD,STABB
. . . N MNUMB,MSTATE,PLAN,CHARCNT
. . . S CHARCNT=0
. . . S CHRTNO=$P($G(^AUPNPAT(PATIEN,41,DUZ(2),0)),U,2)
. . . S ADDR1=$$GET1^DIQ(2,PATIEN,.111)
. . . S ADDR2=$$GET1^DIQ(2,PATIEN,.112)
. . . S ADDR3=$$GET1^DIQ(2,PATIEN,.113)
. . . S CITY=$$GET1^DIQ(2,PATIEN,.114)
. . . S STABB=$$GET1^DIQ(2,PATIEN,.115,"I")
. . . S ST=$$GET1^DIQ(5,STABB,1)
. . . S ZIP=$$GET1^DIQ(2,PATIEN,.116)
. . . N Y S Y=$$GET1^DIQ(2,PATIEN,.03,"I") D DD^%DT S DOB=Y
. . . S AGE=$$GET1^DIQ(9000001,PATIEN,1102.98)
. . . S LASTUPD=$$GET1^DIQ(9000001,PATIEN,.03)
. . . S MCD=$$GET1^DIQ(9000004,MCDNUM,.14)
. . . S MNUMB=$$GET1^DIQ(9000004,MCDNUM,.03)
. . . S COVERAGE=""
. . . I MNUMB'="" D DCOV^AGAGERP2
. . . S MSTATE=$$GET1^DIQ(5,$$GET1^DIQ(9000004,MCDNUM,.04,"I"),1)
. . . S PLAN=$$GET1^DIQ(9000004,MCDNUM,.11)
. . . W !,PATNAM," (",CHRTNO,")(" S CHARCNT=CHARCNT+$L(PATNAM)+$L(CHRTNO)+4
. . . I AGE["MOS" W AGE,")" S CHARCNT=CHARCNT+$L(AGE)+1
. . . I AGE'["MOS" W +AGE,")" S CHARCNT=CHARCNT+$L(+AGE)+1
. . . I CHARCNT<35,$G(MNUMB)'="" W ?35,MNUMB,"(",$G(MSTATE),")"
. . . W ?55,$G(PLAN)
. . . W !,?10,ADDR1
. . . I CHARCNT>34 W ?35,MNUMB,"(",$G(MSTATE),")"
. . . W ?55,COVERAGE
. . . I $G(ADDR2)'="" W !,?10,ADDR2
. . . I $G(ADDR3)'="" W !,?10,ADDR3
. . . W !,?10,CITY," ",ST," ",ZIP
. . . W !,"(MCD) ",MCD
. . . W !,LASTUPD
. . . W !,AGLINE("DASH") S LINECT=LINECT+7
. . . S AGTOTAL=$G(AGTOTAL)+1
. . . I $E(IOST)="C",$Y>(IOSL-5) K DIR D RTRN^AG S ESCAPE=X=U D:'ESCAPE MDHDR^AGAGERP2
. . . I $E(IOST)'="C",$Y>(IOSL-17) W !! D MDHDR^AGAGERP2
W !,"TOTAL RECORDS:",?20,$G(AGTOTAL),!!
I $E(IOST)="C",PATNAM="" K DIR D RTRN^AG
I $E(IOST)'="C" D CLOSE^%ZISH(IO)
Q
;
PRTPRVT ; Print Private Insurance Records
N PAGENO,LINECT,ESCAPE,PATNAM,PATIEN,PRVTNO,PNODE,PNAME,I,AGTOTAL,FOUND,X,MSTATE
S PAGENO=0,ESCAPE=0
D PRVTHDR^AGAGERP2
S PATNAM=""
F S PATNAM=$O(^TMP("AGAGERP",$J,PATNAM)) Q:(PATNAM="")!(ESCAPE) D
. S PATIEN=0
. F S PATIEN=$O(^TMP("AGAGERP",$J,PATNAM,PATIEN)) Q:(+PATIEN=0)!(ESCAPE) D
. . S PRVTNO=""
. . F S PRVTNO=$O(^TMP("AGAGERP",$J,PATNAM,PATIEN,PRVTNO)) Q:(PRVTNO="")!(ESCAPE) D
. . . N CHRTNO,ADDR1,ADDR2,ADDR3,CITY,ST,ZIP,DOB,LASTUPD,COVERAGE,MCD,STABB,PNAME2,WFLG
. . . N PNUMB,PNUMB2,CHARCNT,PHOLDER,START,END,PNODESV,MNUMB
. . . S CHARCNT=0
. . . S FOUND=0
. . . S WFLG=$E(PRVTNO,1)
. . . S CHRTNO=$P($G(^AUPNPAT(PATIEN,41,DUZ(2),0)),U,2)
. . . S ADDR1=$$GET1^DIQ(2,PATIEN,.111)
. . . S ADDR2=$$GET1^DIQ(2,PATIEN,.112)
. . . S ADDR3=$$GET1^DIQ(2,PATIEN,.113)
. . . S CITY=$$GET1^DIQ(2,PATIEN,.114)
. . . S STABB=$$GET1^DIQ(2,PATIEN,.115,"I")
. . . S ST=$$GET1^DIQ(5,STABB,1)
. . . S ZIP=$$GET1^DIQ(2,PATIEN,.116)
. . . N Y S Y=$$GET1^DIQ(2,PATIEN,.03,"I") D DD^%DT S DOB=Y
. . . S AGE=$$GET1^DIQ(9000001,PATIEN,1102.98)
. . . S LASTUPD=$$GET1^DIQ(9000001,PATIEN,.03)
. . . I (WFLG'="M")!(WFLG'="W") D
. . . . S PNODE=0
. . . . F S PNODE=$O(^AUPNPRVT(PATIEN,11,"B",PRVTNO,PNODE)) Q:(+PNODE=0)!(FOUND) D
. . . . . S START=$P($G(^AUPNPRVT(PATIEN,11,PNODE,0)),U,6)
. . . . . S END=$P($G(^AUPNPRVT(PATIEN,11,PNODE,0)),U,7)
. . . . . S FOUND=0
. . . . . I $D(EXCL("Elig Date Range")) D ELGDTCH^AGAGERP1(START,END,.FOUND)
. . . . . I '$D(EXCL("Elig Date Range")) D ELGDTCH2^AGAGERP1(START,END,.FOUND)
. . . . . S PNODESV=+PNODE
. . . . . Q:FOUND
. . . . I $D(PNODESV) S PNODE=PNODESV
. . . . S PNAME=$$GET1^DIQ(9999999.18,PRVTNO,.01)
. . . . S PHOLDER=$P($G(^AUPNPRVT(PATIEN,11,+$G(PNODE),0)),U,8)
. . . . S PNUMB2=$P($G(^AUPNPRVT(PATIEN,11,+$G(PNODE),0)),U,2)
. . . . S PNUMB=$$GET1^DIQ(9000003.1,+$G(PHOLDER),.04)
. . . . I PNUMB="" S PNUMB=$G(PNUMB2)
. . . . S COVERAGE=$$GET1^DIQ(9000003.1,+$G(PHOLDER),.05)
. . . . I COVERAGE="" D PCOV^AGAGERP2
. . . I WFLG="W" D
. . . . S PNAME=$$GET1^DIQ(9999999.18,$E(PRVTNO,3,99),.01)
. . . . S COVERAGE="WORKMEN'S COMP"
. . . I WFLG="M" D
. . . . S MCDNUM=$E(PRVTNO,3,99)
. . . . S PNUMB=$$GET1^DIQ(9000004,MCDNUM,.03)
. . . . S PLAN=$$GET1^DIQ(9000004,MCDNUM,.11)
. . . . S MSTATE=$$GET1^DIQ(9000004,MCDNUM,.04,"I")
. . . . S MSTATE=$$GET1^DIQ(5,MSTATE,1)
. . . . I MSTATE'="" S PNAME=MSTATE_" "_PLAN
. . . . I MSTATE="" S PNAME=PLAN
. . . . I PNUMB'="" D DCOV^AGAGERP2
. . . W !,PATNAM," (",$G(CHRTNO),")(" S CHARCNT=CHARCNT+$L(PATNAM)+$L(CHRTNO)+4
. . . I AGE["MOS" W AGE,")" S CHARCNT=CHARCNT+$L(AGE)+1
. . . I AGE'["MOS" W +AGE,")" S CHARCNT=CHARCNT+$L(+AGE)+1
. . . I CHARCNT<35 W ?35,$G(PNUMB)
. . . W ?53,$E($G(PNAME),1,26)
. . . W !,?10,$G(ADDR1)
. . . I CHARCNT>34 W ?35,$G(PNUMB)
. . . W ?53,$G(COVERAGE)
. . . I $G(ADDR2)'="" W !,?10,$G(ADDR2)
. . . W !,?10,$G(CITY)," ",$G(ST)," ",$G(ZIP)
. . . W !,$G(LASTUPD)
. . . W !,AGLINE("DASH") S LINECT=LINECT+7
. . . S AGTOTAL=$G(AGTOTAL)+1
. . . I $E(IOST)="C",$Y>(IOSL-5) K DIR D RTRN^AG S ESCAPE=X=U D:'ESCAPE PRVTHDR^AGAGERP2
. . . I $E(IOST)'="C",$Y>(IOSL-17) W !! D PRVTHDR^AGAGERP2
W !,"TOTAL RECORDS:",?20,$G(AGTOTAL),!!
I $E(IOST)="C",PATNAM="" K DIR D RTRN^AG
I $E(IOST)'="C" D CLOSE^%ZISH(IO)
Q
;
GETPATN ; Get Specific Patient
N PATNAM,PATNUM,PATNUM,SEL,AGINSLP,EFF,END,AGALTRES,PLAN,ARPLNTYP,ARNTYP,AGSEENLY,FOUND
S PATNUM=+$G(EXCL("Specific Patient"))
S PATNAM=$$GET1^DIQ(2,PATNUM,.01)
Q:(+PATNUM=0)!(PATNAM="")
S ^TMP("AGAGERP",$J)="",^TMP("AGAGERP",$J,PATNAM,PATNUM)=""
K AGINS,AGINSN1,AGINSNN
S SEL=0
I $G(EXCL("Elig Date Range"))'="" S AGSEENLY=1
S AGALTRES=$P($G(EXCL("Alternate Resource")),U,2)
I (AGALTRES="MEDICARE")!(AGALTRES="") D FINDMCR^AGINS(PATNUM),FINDRRE^AGINS(PATNUM)
I (AGALTRES="")!(AGALTRES="MEDICAID")!(AGALTRES="CHIP") D FINDMCD^AGINS(PATNUM)
I (AGALTRES="")!(AGALTRES["PRIVATE") D FINDPVT^AGINS(PATNUM)
K EFF,END,PLAN,ARNOTYP
S AGINSLP=0
F S AGINSLP=$O(AGINS(AGINSLP)) Q:AGINSLP="" D
. S ARNOTYP=$P(AGINS(AGINSLP),U,10)
. I AGALTRES="MEDICAID",ARNOTYP="D" D
. . S PLAN=$P(AGINS(AGINSLP),U,12)
. . I PLAN'="" D
. . . ;S ARPLNTYP=$$GET1^DIQ(9999999.18,PLAN,.21,"I")
. . . S ARPLNTYP=$$INSTYP^AGUTL(PLAN) ;IHS/OIT/NKD AG*7.1*12
. . . I ARPLNTYP="K",AGALTRES="MEDICAID" K AGINS(AGINSLP) Q
. . . I ARPLNTYP'="K",AGALTRES="CHIP" K AGINS(AGINSLP) Q
. I $D(AGINS(AGINSLP)) D
. . S EFF=$P(AGINS(AGINSLP),U,5)
. . S END=$P(AGINS(AGINSLP),U,6)
. . S FOUND=0
. . I $G(EXCL("Elig Date Range"))'="" D ELGDTCH^AGAGERP1(EFF,END,.FOUND)
. . I $G(EXCL("Elig Date Range"))="" D ELGDTCH2^AGAGERP1(EFF,END,.FOUND)
. . I 'FOUND K AGINS(AGINSLP)
Q
AGAGERP3 ; VNGT/IHS/DLS - Patient Age Specific Report ; April 29, 2010
+1 ;;7.1;PATIENT REGISTRATION;**8,9,12,14**;AUG 25, 2005;Build 1
+2 ;
+3 ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
+4 ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
+5 ;
+6 QUIT
PRTMEDC ; Print Medicare Records
+1 NEW PAGENO,LINECT,ESCAPE,PATNAM,PATIEN,MCRNUM,AGTOTAL,X
+2 SET PAGENO=0
SET ESCAPE=0
+3 DO MRHDR^AGAGERP2
+4 SET PATNAM=""
+5 FOR
SET PATNAM=$ORDER(^TMP("AGAGERP",$JOB,PATNAM))
IF (PATNAM="")!(ESCAPE)
QUIT
Begin DoDot:1
+6 SET PATIEN=""
+7 FOR
SET PATIEN=$ORDER(^TMP("AGAGERP",$JOB,PATNAM,PATIEN))
IF PATIEN=""
QUIT
Begin DoDot:2
+8 SET MCRNUM=""
+9 FOR
SET MCRNUM=$ORDER(^TMP("AGAGERP",$JOB,PATNAM,PATIEN,MCRNUM))
IF MCRNUM=""
QUIT
Begin DoDot:3
+10 NEW CHRTNO,ADDR1,ADDR2,ADDR3,CITY,ST,ZIP,AGE,DOB,LASTUPD,COVERAGE,MCR,STABB
+11 NEW MNUMB,MSUFF,RNUMB,RPREF,COVNO
+12 SET CHRTNO=$PIECE($GET(^AUPNPAT(PATIEN,41,DUZ(2),0)),U,2)
+13 SET ADDR1=$$GET1^DIQ(2,PATIEN,.111)
+14 SET ADDR2=$$GET1^DIQ(2,PATIEN,.112)
+15 SET ADDR3=$$GET1^DIQ(2,PATIEN,.113)
+16 SET CITY=$$GET1^DIQ(2,PATIEN,.114)
+17 SET STABB=$$GET1^DIQ(2,PATIEN,.115,"I")
+18 SET ST=$$GET1^DIQ(5,STABB,1)
+19 SET ZIP=$$GET1^DIQ(2,PATIEN,.116)
+20 NEW Y
SET Y=$$GET1^DIQ(2,PATIEN,.03,"I")
DO DD^%DT
SET DOB=Y
+21 SET AGE=$$GET1^DIQ(9000001,PATIEN,1102.98)
+22 SET LASTUPD=$$GET1^DIQ(9000001,PATIEN,.03)
+23 SET MCR=$$GET1^DIQ(9000003,MCRNUM,.14)
+24 SET MNUMB=$$GET1^DIQ(9000003,MCRNUM,.03)
+25 SET RNUMB=$$GET1^DIQ(9000005,MCRNUM,.04)
+26 SET COVERAGE=""
+27 SET COVNO=1
+28 IF $GET(MNUMB)'=""
DO MCOV^AGAGERP2
+29 IF $GET(RNUMB)'=""
DO RCOV^AGAGERP2
+30 ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
IF $$HASMBI^AGUTL(PATIEN)
IF $$HASELIG^AGEDERR2(PATIEN)["MCR"
DO MCOV^AGAGERP2
+31 ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
IF $$HASMBI^AGUTL(PATIEN)
IF $$HASELIG^AGEDERR2(PATIEN)["RRE"
DO RCOV^AGAGERP2
+32 ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
IF $DATA(COVERAGE)
SET COVERAGE=$PIECE(COVERAGE,"/D",1)
SET COVERAGE=$PIECE(COVERAGE,"D",1)
+33 SET MSUFF=$$GET1^DIQ(9000003,MCRNUM,.04)
+34 SET RPREF=$$GET1^DIQ(9000005,MCRNUM,.03)
+35 WRITE !,PATNAM," (",CHRTNO,")("
+36 IF AGE["MOS"
WRITE AGE,")"
+37 IF AGE'["MOS"
WRITE +AGE,")"
+38 ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2 - START OLD CODE
+39 ;I MNUMB'="" W ?47,"M=",MNUMB I MSUFF'="" W "-",MSUFF
+40 ;I RNUMB'="",MNUMB="" W ?47,"R=",RPREF,RNUMB
+41 ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2 - END OLD CODE - START NEW CODE
+42 IF $$HASMBI^AGUTL(PATIEN)
WRITE ?47,$SELECT($$HASELIG^AGEDERR2(PATIEN)["MCR":"M=",$$HASELIG^AGEDERR2(PATIEN)["RRE":"R=",1:"M="),$$GETMBI^AUPNMBI(PATIEN,$$DT^XLFDT)
+43 IF '$TEST
IF MNUMB'=""
WRITE ?47,"M=",MNUMB
IF MSUFF'=""
WRITE "-",MSUFF
+44 IF '$TEST
IF RNUMB'=""
IF MNUMB=""
WRITE ?47,"R=",RPREF,RNUMB
+45 ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2 - END NEW CODE
+46 IF $PIECE(COVERAGE,"/",COVNO)'=""
WRITE ?69,"PART ",$PIECE(COVERAGE,"/",COVNO)
SET COVNO=COVNO+1
+47 WRITE !,?10,ADDR1
+48 ;I RNUMB'="",MNUMB'="" W ?47,"R=",RPREF,RNUMB ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
+49 ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
IF $$HASMBI^AGUTL(PATIEN)
IF $$HASELIG^AGEDERR2(PATIEN)["MCR"
IF $$HASELIG^AGEDERR2(PATIEN)["RRE"
WRITE ?47,"R=",$$GETMBI^AUPNMBI(PATIEN,$$DT^XLFDT)
+50 ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
IF '$TEST
IF RNUMB'=""
IF MNUMB'=""
WRITE ?47,"R=",RPREF,RNUMB
+51 IF $PIECE(COVERAGE,"/",COVNO)'=""
WRITE ?69,"PART ",$PIECE(COVERAGE,"/",COVNO)
SET COVNO=COVNO+1
+52 IF $GET(ADDR2)'=""
WRITE !,?10,ADDR2
IF $PIECE(COVERAGE,"/",COVNO)'=""
WRITE ?69,"PART ",$PIECE(COVERAGE,"/",COVNO)
SET COVNO=COVNO+1
+53 IF $GET(ADDR3)'=""
WRITE !,?10,ADDR3
IF $PIECE(COVERAGE,"/",COVNO)'=""
WRITE ?69,"PART ",$PIECE(COVERAGE,"/",COVNO)
SET COVNO=COVNO+1
+54 WRITE !,?10,CITY," ",ST," ",ZIP
IF $PIECE(COVERAGE,"/",COVNO)'=""
WRITE ?69,"PART ",$PIECE(COVERAGE,"/",COVNO)
SET COVNO=COVNO+1
+55 WRITE !,"(MCR) ",MCR
+56 WRITE !,LASTUPD
+57 WRITE !,AGLINE("DASH")
SET LINECT=LINECT+7
+58 IF $EXTRACT(IOST)="C"
IF $Y>(IOSL-5)
KILL DIR
DO RTRN^AG
SET ESCAPE=X=U
IF 'ESCAPE
DO MRHDR^AGAGERP2
+59 IF $EXTRACT(IOST)'="C"
IF $Y>(IOSL-17)
WRITE !!
DO MRHDR^AGAGERP2
+60 SET AGTOTAL=$GET(AGTOTAL)+1
End DoDot:3
End DoDot:2
End DoDot:1
+61 WRITE !,"TOTAL RECORDS:",?20,$GET(AGTOTAL),!!
+62 IF $EXTRACT(IOST)="C"
IF PATNAM=""
KILL DIR
DO RTRN^AG
+63 IF $EXTRACT(IOST)'="C"
DO CLOSE^%ZISH(IO)
+64 QUIT
+65 ;
PRTMEDD ; Print Medicaid Records
+1 NEW PAGENO,LINECT,ESCAPE,PATNAM,PATIEN,MCDNUM,AGTOTAL,X
+2 SET PAGENO=0
SET ESCAPE=0
+3 DO MDHDR^AGAGERP2
+4 SET PATNAM=""
+5 FOR
SET PATNAM=$ORDER(^TMP("AGAGERP",$JOB,PATNAM))
IF (PATNAM="")!(ESCAPE)
QUIT
Begin DoDot:1
+6 SET PATIEN=""
+7 FOR
SET PATIEN=$ORDER(^TMP("AGAGERP",$JOB,PATNAM,PATIEN))
IF (PATIEN="")!(ESCAPE)
QUIT
Begin DoDot:2
+8 SET MCDNUM=""
+9 FOR
SET MCDNUM=$ORDER(^TMP("AGAGERP",$JOB,PATNAM,PATIEN,MCDNUM))
IF (MCDNUM="")!(ESCAPE)
QUIT
Begin DoDot:3
+10 NEW CHRTNO,ADDR1,ADDR2,ADDR3,CITY,ST,ZIP,DOB,LASTUPD,COVERAGE,MCD,STABB
+11 NEW MNUMB,MSTATE,PLAN,CHARCNT
+12 SET CHARCNT=0
+13 SET CHRTNO=$PIECE($GET(^AUPNPAT(PATIEN,41,DUZ(2),0)),U,2)
+14 SET ADDR1=$$GET1^DIQ(2,PATIEN,.111)
+15 SET ADDR2=$$GET1^DIQ(2,PATIEN,.112)
+16 SET ADDR3=$$GET1^DIQ(2,PATIEN,.113)
+17 SET CITY=$$GET1^DIQ(2,PATIEN,.114)
+18 SET STABB=$$GET1^DIQ(2,PATIEN,.115,"I")
+19 SET ST=$$GET1^DIQ(5,STABB,1)
+20 SET ZIP=$$GET1^DIQ(2,PATIEN,.116)
+21 NEW Y
SET Y=$$GET1^DIQ(2,PATIEN,.03,"I")
DO DD^%DT
SET DOB=Y
+22 SET AGE=$$GET1^DIQ(9000001,PATIEN,1102.98)
+23 SET LASTUPD=$$GET1^DIQ(9000001,PATIEN,.03)
+24 SET MCD=$$GET1^DIQ(9000004,MCDNUM,.14)
+25 SET MNUMB=$$GET1^DIQ(9000004,MCDNUM,.03)
+26 SET COVERAGE=""
+27 IF MNUMB'=""
DO DCOV^AGAGERP2
+28 SET MSTATE=$$GET1^DIQ(5,$$GET1^DIQ(9000004,MCDNUM,.04,"I"),1)
+29 SET PLAN=$$GET1^DIQ(9000004,MCDNUM,.11)
+30 WRITE !,PATNAM," (",CHRTNO,")("
SET CHARCNT=CHARCNT+$LENGTH(PATNAM)+$LENGTH(CHRTNO)+4
+31 IF AGE["MOS"
WRITE AGE,")"
SET CHARCNT=CHARCNT+$LENGTH(AGE)+1
+32 IF AGE'["MOS"
WRITE +AGE,")"
SET CHARCNT=CHARCNT+$LENGTH(+AGE)+1
+33 IF CHARCNT<35
IF $GET(MNUMB)'=""
WRITE ?35,MNUMB,"(",$GET(MSTATE),")"
+34 WRITE ?55,$GET(PLAN)
+35 WRITE !,?10,ADDR1
+36 IF CHARCNT>34
WRITE ?35,MNUMB,"(",$GET(MSTATE),")"
+37 WRITE ?55,COVERAGE
+38 IF $GET(ADDR2)'=""
WRITE !,?10,ADDR2
+39 IF $GET(ADDR3)'=""
WRITE !,?10,ADDR3
+40 WRITE !,?10,CITY," ",ST," ",ZIP
+41 WRITE !,"(MCD) ",MCD
+42 WRITE !,LASTUPD
+43 WRITE !,AGLINE("DASH")
SET LINECT=LINECT+7
+44 SET AGTOTAL=$GET(AGTOTAL)+1
+45 IF $EXTRACT(IOST)="C"
IF $Y>(IOSL-5)
KILL DIR
DO RTRN^AG
SET ESCAPE=X=U
IF 'ESCAPE
DO MDHDR^AGAGERP2
+46 IF $EXTRACT(IOST)'="C"
IF $Y>(IOSL-17)
WRITE !!
DO MDHDR^AGAGERP2
End DoDot:3
End DoDot:2
End DoDot:1
+47 WRITE !,"TOTAL RECORDS:",?20,$GET(AGTOTAL),!!
+48 IF $EXTRACT(IOST)="C"
IF PATNAM=""
KILL DIR
DO RTRN^AG
+49 IF $EXTRACT(IOST)'="C"
DO CLOSE^%ZISH(IO)
+50 QUIT
+51 ;
PRTPRVT ; Print Private Insurance Records
+1 NEW PAGENO,LINECT,ESCAPE,PATNAM,PATIEN,PRVTNO,PNODE,PNAME,I,AGTOTAL,FOUND,X,MSTATE
+2 SET PAGENO=0
SET ESCAPE=0
+3 DO PRVTHDR^AGAGERP2
+4 SET PATNAM=""
+5 FOR
SET PATNAM=$ORDER(^TMP("AGAGERP",$JOB,PATNAM))
IF (PATNAM="")!(ESCAPE)
QUIT
Begin DoDot:1
+6 SET PATIEN=0
+7 FOR
SET PATIEN=$ORDER(^TMP("AGAGERP",$JOB,PATNAM,PATIEN))
IF (+PATIEN=0)!(ESCAPE)
QUIT
Begin DoDot:2
+8 SET PRVTNO=""
+9 FOR
SET PRVTNO=$ORDER(^TMP("AGAGERP",$JOB,PATNAM,PATIEN,PRVTNO))
IF (PRVTNO="")!(ESCAPE)
QUIT
Begin DoDot:3
+10 NEW CHRTNO,ADDR1,ADDR2,ADDR3,CITY,ST,ZIP,DOB,LASTUPD,COVERAGE,MCD,STABB,PNAME2,WFLG
+11 NEW PNUMB,PNUMB2,CHARCNT,PHOLDER,START,END,PNODESV,MNUMB
+12 SET CHARCNT=0
+13 SET FOUND=0
+14 SET WFLG=$EXTRACT(PRVTNO,1)
+15 SET CHRTNO=$PIECE($GET(^AUPNPAT(PATIEN,41,DUZ(2),0)),U,2)
+16 SET ADDR1=$$GET1^DIQ(2,PATIEN,.111)
+17 SET ADDR2=$$GET1^DIQ(2,PATIEN,.112)
+18 SET ADDR3=$$GET1^DIQ(2,PATIEN,.113)
+19 SET CITY=$$GET1^DIQ(2,PATIEN,.114)
+20 SET STABB=$$GET1^DIQ(2,PATIEN,.115,"I")
+21 SET ST=$$GET1^DIQ(5,STABB,1)
+22 SET ZIP=$$GET1^DIQ(2,PATIEN,.116)
+23 NEW Y
SET Y=$$GET1^DIQ(2,PATIEN,.03,"I")
DO DD^%DT
SET DOB=Y
+24 SET AGE=$$GET1^DIQ(9000001,PATIEN,1102.98)
+25 SET LASTUPD=$$GET1^DIQ(9000001,PATIEN,.03)
+26 IF (WFLG'="M")!(WFLG'="W")
Begin DoDot:4
+27 SET PNODE=0
+28 FOR
SET PNODE=$ORDER(^AUPNPRVT(PATIEN,11,"B",PRVTNO,PNODE))
IF (+PNODE=0)!(FOUND)
QUIT
Begin DoDot:5
+29 SET START=$PIECE($GET(^AUPNPRVT(PATIEN,11,PNODE,0)),U,6)
+30 SET END=$PIECE($GET(^AUPNPRVT(PATIEN,11,PNODE,0)),U,7)
+31 SET FOUND=0
+32 IF $DATA(EXCL("Elig Date Range"))
DO ELGDTCH^AGAGERP1(START,END,.FOUND)
+33 IF '$DATA(EXCL("Elig Date Range"))
DO ELGDTCH2^AGAGERP1(START,END,.FOUND)
+34 SET PNODESV=+PNODE
+35 IF FOUND
QUIT
End DoDot:5
+36 IF $DATA(PNODESV)
SET PNODE=PNODESV
+37 SET PNAME=$$GET1^DIQ(9999999.18,PRVTNO,.01)
+38 SET PHOLDER=$PIECE($GET(^AUPNPRVT(PATIEN,11,+$GET(PNODE),0)),U,8)
+39 SET PNUMB2=$PIECE($GET(^AUPNPRVT(PATIEN,11,+$GET(PNODE),0)),U,2)
+40 SET PNUMB=$$GET1^DIQ(9000003.1,+$GET(PHOLDER),.04)
+41 IF PNUMB=""
SET PNUMB=$GET(PNUMB2)
+42 SET COVERAGE=$$GET1^DIQ(9000003.1,+$GET(PHOLDER),.05)
+43 IF COVERAGE=""
DO PCOV^AGAGERP2
End DoDot:4
+44 IF WFLG="W"
Begin DoDot:4
+45 SET PNAME=$$GET1^DIQ(9999999.18,$EXTRACT(PRVTNO,3,99),.01)
+46 SET COVERAGE="WORKMEN'S COMP"
End DoDot:4
+47 IF WFLG="M"
Begin DoDot:4
+48 SET MCDNUM=$EXTRACT(PRVTNO,3,99)
+49 SET PNUMB=$$GET1^DIQ(9000004,MCDNUM,.03)
+50 SET PLAN=$$GET1^DIQ(9000004,MCDNUM,.11)
+51 SET MSTATE=$$GET1^DIQ(9000004,MCDNUM,.04,"I")
+52 SET MSTATE=$$GET1^DIQ(5,MSTATE,1)
+53 IF MSTATE'=""
SET PNAME=MSTATE_" "_PLAN
+54 IF MSTATE=""
SET PNAME=PLAN
+55 IF PNUMB'=""
DO DCOV^AGAGERP2
End DoDot:4
+56 WRITE !,PATNAM," (",$GET(CHRTNO),")("
SET CHARCNT=CHARCNT+$LENGTH(PATNAM)+$LENGTH(CHRTNO)+4
+57 IF AGE["MOS"
WRITE AGE,")"
SET CHARCNT=CHARCNT+$LENGTH(AGE)+1
+58 IF AGE'["MOS"
WRITE +AGE,")"
SET CHARCNT=CHARCNT+$LENGTH(+AGE)+1
+59 IF CHARCNT<35
WRITE ?35,$GET(PNUMB)
+60 WRITE ?53,$EXTRACT($GET(PNAME),1,26)
+61 WRITE !,?10,$GET(ADDR1)
+62 IF CHARCNT>34
WRITE ?35,$GET(PNUMB)
+63 WRITE ?53,$GET(COVERAGE)
+64 IF $GET(ADDR2)'=""
WRITE !,?10,$GET(ADDR2)
+65 WRITE !,?10,$GET(CITY)," ",$GET(ST)," ",$GET(ZIP)
+66 WRITE !,$GET(LASTUPD)
+67 WRITE !,AGLINE("DASH")
SET LINECT=LINECT+7
+68 SET AGTOTAL=$GET(AGTOTAL)+1
+69 IF $EXTRACT(IOST)="C"
IF $Y>(IOSL-5)
KILL DIR
DO RTRN^AG
SET ESCAPE=X=U
IF 'ESCAPE
DO PRVTHDR^AGAGERP2
+70 IF $EXTRACT(IOST)'="C"
IF $Y>(IOSL-17)
WRITE !!
DO PRVTHDR^AGAGERP2
End DoDot:3
End DoDot:2
End DoDot:1
+71 WRITE !,"TOTAL RECORDS:",?20,$GET(AGTOTAL),!!
+72 IF $EXTRACT(IOST)="C"
IF PATNAM=""
KILL DIR
DO RTRN^AG
+73 IF $EXTRACT(IOST)'="C"
DO CLOSE^%ZISH(IO)
+74 QUIT
+75 ;
GETPATN ; Get Specific Patient
+1 NEW PATNAM,PATNUM,PATNUM,SEL,AGINSLP,EFF,END,AGALTRES,PLAN,ARPLNTYP,ARNTYP,AGSEENLY,FOUND
+2 SET PATNUM=+$GET(EXCL("Specific Patient"))
+3 SET PATNAM=$$GET1^DIQ(2,PATNUM,.01)
+4 IF (+PATNUM=0)!(PATNAM="")
QUIT
+5 SET ^TMP("AGAGERP",$JOB)=""
SET ^TMP("AGAGERP",$JOB,PATNAM,PATNUM)=""
+6 KILL AGINS,AGINSN1,AGINSNN
+7 SET SEL=0
+8 IF $GET(EXCL("Elig Date Range"))'=""
SET AGSEENLY=1
+9 SET AGALTRES=$PIECE($GET(EXCL("Alternate Resource")),U,2)
+10 IF (AGALTRES="MEDICARE")!(AGALTRES="")
DO FINDMCR^AGINS(PATNUM)
DO FINDRRE^AGINS(PATNUM)
+11 IF (AGALTRES="")!(AGALTRES="MEDICAID")!(AGALTRES="CHIP")
DO FINDMCD^AGINS(PATNUM)
+12 IF (AGALTRES="")!(AGALTRES["PRIVATE")
DO FINDPVT^AGINS(PATNUM)
+13 KILL EFF,END,PLAN,ARNOTYP
+14 SET AGINSLP=0
+15 FOR
SET AGINSLP=$ORDER(AGINS(AGINSLP))
IF AGINSLP=""
QUIT
Begin DoDot:1
+16 SET ARNOTYP=$PIECE(AGINS(AGINSLP),U,10)
+17 IF AGALTRES="MEDICAID"
IF ARNOTYP="D"
Begin DoDot:2
+18 SET PLAN=$PIECE(AGINS(AGINSLP),U,12)
+19 IF PLAN'=""
Begin DoDot:3
+20 ;S ARPLNTYP=$$GET1^DIQ(9999999.18,PLAN,.21,"I")
+21 ;IHS/OIT/NKD AG*7.1*12
SET ARPLNTYP=$$INSTYP^AGUTL(PLAN)
+22 IF ARPLNTYP="K"
IF AGALTRES="MEDICAID"
KILL AGINS(AGINSLP)
QUIT
+23 IF ARPLNTYP'="K"
IF AGALTRES="CHIP"
KILL AGINS(AGINSLP)
QUIT
End DoDot:3
End DoDot:2
+24 IF $DATA(AGINS(AGINSLP))
Begin DoDot:2
+25 SET EFF=$PIECE(AGINS(AGINSLP),U,5)
+26 SET END=$PIECE(AGINS(AGINSLP),U,6)
+27 SET FOUND=0
+28 IF $GET(EXCL("Elig Date Range"))'=""
DO ELGDTCH^AGAGERP1(EFF,END,.FOUND)
+29 IF $GET(EXCL("Elig Date Range"))=""
DO ELGDTCH2^AGAGERP1(EFF,END,.FOUND)
+30 IF 'FOUND
KILL AGINS(AGINSLP)
End DoDot:2
End DoDot:1
+31 QUIT
