Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGAGERP3

AGAGERP3.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
  1.  ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
  1.  ;
  1.  Q
  1. PRTMEDC ; Print Medicare Records
  1.  N PAGENO,LINECT,ESCAPE,PATNAM,PATIEN,MCRNUM,AGTOTAL,X
  1.  S PAGENO=0,ESCAPE=0
  1.  D MRHDR^AGAGERP2
  1.  S PATNAM=""
  1.  F  S PATNAM=$O(^TMP("AGAGERP",$J,PATNAM)) Q:(PATNAM="")!(ESCAPE)  D
  1.  . S PATIEN=""
  1.  . F  S PATIEN=$O(^TMP("AGAGERP",$J,PATNAM,PATIEN)) Q:PATIEN=""  D
  1.  . . S MCRNUM=""
  1.  . . F  S MCRNUM=$O(^TMP("AGAGERP",$J,PATNAM,PATIEN,MCRNUM)) Q:MCRNUM=""  D
  1.  . . . N CHRTNO,ADDR1,ADDR2,ADDR3,CITY,ST,ZIP,AGE,DOB,LASTUPD,COVERAGE,MCR,STABB
  1.  . . . N MNUMB,MSUFF,RNUMB,RPREF,COVNO
  1.  . . . S CHRTNO=$P($G(^AUPNPAT(PATIEN,41,DUZ(2),0)),U,2)
  1.  . . . S ADDR1=$$GET1^DIQ(2,PATIEN,.111)
  1.  . . . S ADDR2=$$GET1^DIQ(2,PATIEN,.112)
  1.  . . . S ADDR3=$$GET1^DIQ(2,PATIEN,.113)
  1.  . . . S CITY=$$GET1^DIQ(2,PATIEN,.114)
  1.  . . . S STABB=$$GET1^DIQ(2,PATIEN,.115,"I")
  1.  . . . S ST=$$GET1^DIQ(5,STABB,1)
  1.  . . . S ZIP=$$GET1^DIQ(2,PATIEN,.116)
  1.  . . . N Y S Y=$$GET1^DIQ(2,PATIEN,.03,"I") D DD^%DT S DOB=Y
  1.  . . . S AGE=$$GET1^DIQ(9000001,PATIEN,1102.98)
  1.  . . . S LASTUPD=$$GET1^DIQ(9000001,PATIEN,.03)
  1.  . . . S MCR=$$GET1^DIQ(9000003,MCRNUM,.14)
  1.  . . . S MNUMB=$$GET1^DIQ(9000003,MCRNUM,.03)
  1.  . . . S RNUMB=$$GET1^DIQ(9000005,MCRNUM,.04)
  1.  . . . S COVERAGE=""
  1.  . . . S COVNO=1
  1.  . . . I $G(MNUMB)'="" D MCOV^AGAGERP2
  1.  . . . I $G(RNUMB)'="" D RCOV^AGAGERP2
  1.  . . . I $$HASMBI^AGUTL(PATIEN),$$HASELIG^AGEDERR2(PATIEN)["MCR" D MCOV^AGAGERP2  ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
  1.  . . . I $$HASMBI^AGUTL(PATIEN),$$HASELIG^AGEDERR2(PATIEN)["RRE" D RCOV^AGAGERP2  ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
  1.  . . . S:$D(COVERAGE) COVERAGE=$P(COVERAGE,"/D",1),COVERAGE=$P(COVERAGE,"D",1)  ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
  1.  . . . S MSUFF=$$GET1^DIQ(9000003,MCRNUM,.04)
  1.  . . . S RPREF=$$GET1^DIQ(9000005,MCRNUM,.03)
  1.  . . . W !,PATNAM," (",CHRTNO,")("
  1.  . . . I AGE["MOS" W AGE,")"
  1.  . . . I AGE'["MOS" W +AGE,")"
  1.  . . . ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2 - START OLD CODE
  1.  . . . ;I MNUMB'="" W ?47,"M=",MNUMB I MSUFF'="" W "-",MSUFF
  1.  . . . ;I RNUMB'="",MNUMB="" W ?47,"R=",RPREF,RNUMB
  1.  . . . ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2 - END OLD CODE - START NEW CODE
  1.  . . . I $$HASMBI^AGUTL(PATIEN) W ?47,$S($$HASELIG^AGEDERR2(PATIEN)["MCR":"M=",$$HASELIG^AGEDERR2(PATIEN)["RRE":"R=",1:"M="),$$GETMBI^AUPNMBI(PATIEN,$$DT^XLFDT)
  1.  . . . E  I MNUMB'="" W ?47,"M=",MNUMB I MSUFF'="" W "-",MSUFF
  1.  . . . E  I RNUMB'="",MNUMB="" W ?47,"R=",RPREF,RNUMB
  1.  . . . ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2 - END NEW CODE
  1.  . . . I $P(COVERAGE,"/",COVNO)'="" W ?69,"PART ",$P(COVERAGE,"/",COVNO) S COVNO=COVNO+1
  1.  . . . W !,?10,ADDR1
  1.  . . . ;I RNUMB'="",MNUMB'="" W ?47,"R=",RPREF,RNUMB  ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
  1.  . . . 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
  1.  . . . E  I RNUMB'="",MNUMB'="" W ?47,"R=",RPREF,RNUMB  ;IHS/OIT/NKD AG*7.1*14 MBI PHASE 2
  1.  . . . I $P(COVERAGE,"/",COVNO)'="" W ?69,"PART ",$P(COVERAGE,"/",COVNO) S COVNO=COVNO+1
  1.  . . . I $G(ADDR2)'="" W !,?10,ADDR2 I $P(COVERAGE,"/",COVNO)'="" W ?69,"PART ",$P(COVERAGE,"/",COVNO) S COVNO=COVNO+1
  1.  . . . I $G(ADDR3)'="" W !,?10,ADDR3 I $P(COVERAGE,"/",COVNO)'="" W ?69,"PART ",$P(COVERAGE,"/",COVNO) S COVNO=COVNO+1
  1.  . . . W !,?10,CITY," ",ST," ",ZIP I $P(COVERAGE,"/",COVNO)'="" W ?69,"PART ",$P(COVERAGE,"/",COVNO) S COVNO=COVNO+1
  1.  . . . W !,"(MCR) ",MCR
  1.  . . . W !,LASTUPD
  1.  . . . W !,AGLINE("DASH") S LINECT=LINECT+7
  1.  . . . I $E(IOST)="C",$Y>(IOSL-5) K DIR D RTRN^AG S ESCAPE=X=U D:'ESCAPE MRHDR^AGAGERP2
  1.  . . . I $E(IOST)'="C",$Y>(IOSL-17) W !! D MRHDR^AGAGERP2
  1.  . . . S AGTOTAL=$G(AGTOTAL)+1
  1.  W !,"TOTAL RECORDS:",?20,$G(AGTOTAL),!!
  1.  I $E(IOST)="C",PATNAM="" K DIR D RTRN^AG
  1.  I $E(IOST)'="C" D CLOSE^%ZISH(IO)
  1.  Q
  1.  ;
  1. PRTMEDD ; Print Medicaid Records
  1.  N PAGENO,LINECT,ESCAPE,PATNAM,PATIEN,MCDNUM,AGTOTAL,X
  1.  S PAGENO=0,ESCAPE=0
  1.  D MDHDR^AGAGERP2
  1.  S PATNAM=""
  1.  F  S PATNAM=$O(^TMP("AGAGERP",$J,PATNAM)) Q:(PATNAM="")!(ESCAPE)  D
  1.  . S PATIEN=""
  1.  . F  S PATIEN=$O(^TMP("AGAGERP",$J,PATNAM,PATIEN)) Q:(PATIEN="")!(ESCAPE)  D
  1.  . . S MCDNUM=""
  1.  . . F  S MCDNUM=$O(^TMP("AGAGERP",$J,PATNAM,PATIEN,MCDNUM)) Q:(MCDNUM="")!(ESCAPE)  D
  1.  . . . N CHRTNO,ADDR1,ADDR2,ADDR3,CITY,ST,ZIP,DOB,LASTUPD,COVERAGE,MCD,STABB
  1.  . . . N MNUMB,MSTATE,PLAN,CHARCNT
  1.  . . . S CHARCNT=0
  1.  . . . S CHRTNO=$P($G(^AUPNPAT(PATIEN,41,DUZ(2),0)),U,2)
  1.  . . . S ADDR1=$$GET1^DIQ(2,PATIEN,.111)
  1.  . . . S ADDR2=$$GET1^DIQ(2,PATIEN,.112)
  1.  . . . S ADDR3=$$GET1^DIQ(2,PATIEN,.113)
  1.  . . . S CITY=$$GET1^DIQ(2,PATIEN,.114)
  1.  . . . S STABB=$$GET1^DIQ(2,PATIEN,.115,"I")
  1.  . . . S ST=$$GET1^DIQ(5,STABB,1)
  1.  . . . S ZIP=$$GET1^DIQ(2,PATIEN,.116)
  1.  . . . N Y S Y=$$GET1^DIQ(2,PATIEN,.03,"I") D DD^%DT S DOB=Y
  1.  . . . S AGE=$$GET1^DIQ(9000001,PATIEN,1102.98)
  1.  . . . S LASTUPD=$$GET1^DIQ(9000001,PATIEN,.03)
  1.  . . . S MCD=$$GET1^DIQ(9000004,MCDNUM,.14)
  1.  . . . S MNUMB=$$GET1^DIQ(9000004,MCDNUM,.03)
  1.  . . . S COVERAGE=""
  1.  . . . I MNUMB'="" D DCOV^AGAGERP2
  1.  . . . S MSTATE=$$GET1^DIQ(5,$$GET1^DIQ(9000004,MCDNUM,.04,"I"),1)
  1.  . . . S PLAN=$$GET1^DIQ(9000004,MCDNUM,.11)
  1.  . . . W !,PATNAM," (",CHRTNO,")(" S CHARCNT=CHARCNT+$L(PATNAM)+$L(CHRTNO)+4
  1.  . . . I AGE["MOS" W AGE,")" S CHARCNT=CHARCNT+$L(AGE)+1
  1.  . . . I AGE'["MOS" W +AGE,")" S CHARCNT=CHARCNT+$L(+AGE)+1
  1.  . . . I CHARCNT<35,$G(MNUMB)'="" W ?35,MNUMB,"(",$G(MSTATE),")"
  1.  . . . W ?55,$G(PLAN)
  1.  . . . W !,?10,ADDR1
  1.  . . . I CHARCNT>34 W ?35,MNUMB,"(",$G(MSTATE),")"
  1.  . . . W ?55,COVERAGE
  1.  . . . I $G(ADDR2)'="" W !,?10,ADDR2
  1.  . . . I $G(ADDR3)'="" W !,?10,ADDR3
  1.  . . . W !,?10,CITY," ",ST," ",ZIP
  1.  . . . W !,"(MCD) ",MCD
  1.  . . . W !,LASTUPD
  1.  . . . W !,AGLINE("DASH") S LINECT=LINECT+7
  1.  . . . S AGTOTAL=$G(AGTOTAL)+1
  1.  . . . I $E(IOST)="C",$Y>(IOSL-5) K DIR D RTRN^AG S ESCAPE=X=U D:'ESCAPE MDHDR^AGAGERP2
  1.  . . . I $E(IOST)'="C",$Y>(IOSL-17) W !! D MDHDR^AGAGERP2
  1.  W !,"TOTAL RECORDS:",?20,$G(AGTOTAL),!!
  1.  I $E(IOST)="C",PATNAM="" K DIR D RTRN^AG
  1.  I $E(IOST)'="C" D CLOSE^%ZISH(IO)
  1.  Q
  1.  ;
  1. PRTPRVT ; Print Private Insurance Records
  1.  N PAGENO,LINECT,ESCAPE,PATNAM,PATIEN,PRVTNO,PNODE,PNAME,I,AGTOTAL,FOUND,X,MSTATE
  1.  S PAGENO=0,ESCAPE=0
  1.  D PRVTHDR^AGAGERP2
  1.  S PATNAM=""
  1.  F  S PATNAM=$O(^TMP("AGAGERP",$J,PATNAM)) Q:(PATNAM="")!(ESCAPE)  D
  1.  . S PATIEN=0
  1.  . F  S PATIEN=$O(^TMP("AGAGERP",$J,PATNAM,PATIEN)) Q:(+PATIEN=0)!(ESCAPE)  D
  1.  . . S PRVTNO=""
  1.  . . F  S PRVTNO=$O(^TMP("AGAGERP",$J,PATNAM,PATIEN,PRVTNO)) Q:(PRVTNO="")!(ESCAPE)  D
  1.  . . . N CHRTNO,ADDR1,ADDR2,ADDR3,CITY,ST,ZIP,DOB,LASTUPD,COVERAGE,MCD,STABB,PNAME2,WFLG
  1.  . . . N PNUMB,PNUMB2,CHARCNT,PHOLDER,START,END,PNODESV,MNUMB
  1.  . . . S CHARCNT=0
  1.  . . . S FOUND=0
  1.  . . . S WFLG=$E(PRVTNO,1)
  1.  . . . S CHRTNO=$P($G(^AUPNPAT(PATIEN,41,DUZ(2),0)),U,2)
  1.  . . . S ADDR1=$$GET1^DIQ(2,PATIEN,.111)
  1.  . . . S ADDR2=$$GET1^DIQ(2,PATIEN,.112)
  1.  . . . S ADDR3=$$GET1^DIQ(2,PATIEN,.113)
  1.  . . . S CITY=$$GET1^DIQ(2,PATIEN,.114)
  1.  . . . S STABB=$$GET1^DIQ(2,PATIEN,.115,"I")
  1.  . . . S ST=$$GET1^DIQ(5,STABB,1)
  1.  . . . S ZIP=$$GET1^DIQ(2,PATIEN,.116)
  1.  . . . N Y S Y=$$GET1^DIQ(2,PATIEN,.03,"I") D DD^%DT S DOB=Y
  1.  . . . S AGE=$$GET1^DIQ(9000001,PATIEN,1102.98)
  1.  . . . S LASTUPD=$$GET1^DIQ(9000001,PATIEN,.03)
  1.  . . . I (WFLG'="M")!(WFLG'="W") D
  1.  . . . . S PNODE=0
  1.  . . . . F  S PNODE=$O(^AUPNPRVT(PATIEN,11,"B",PRVTNO,PNODE)) Q:(+PNODE=0)!(FOUND)  D
  1.  . . . . . S START=$P($G(^AUPNPRVT(PATIEN,11,PNODE,0)),U,6)
  1.  . . . . . S END=$P($G(^AUPNPRVT(PATIEN,11,PNODE,0)),U,7)
  1.  . . . . . S FOUND=0
  1.  . . . . . I $D(EXCL("Elig Date Range")) D ELGDTCH^AGAGERP1(START,END,.FOUND)
  1.  . . . . . I '$D(EXCL("Elig Date Range")) D ELGDTCH2^AGAGERP1(START,END,.FOUND)
  1.  . . . . . S PNODESV=+PNODE
  1.  . . . . . Q:FOUND
  1.  . . . . I $D(PNODESV) S PNODE=PNODESV
  1.  . . . . S PNAME=$$GET1^DIQ(9999999.18,PRVTNO,.01)
  1.  . . . . S PHOLDER=$P($G(^AUPNPRVT(PATIEN,11,+$G(PNODE),0)),U,8)
  1.  . . . . S PNUMB2=$P($G(^AUPNPRVT(PATIEN,11,+$G(PNODE),0)),U,2)
  1.  . . . . S PNUMB=$$GET1^DIQ(9000003.1,+$G(PHOLDER),.04)
  1.  . . . . I PNUMB="" S PNUMB=$G(PNUMB2)
  1.  . . . . S COVERAGE=$$GET1^DIQ(9000003.1,+$G(PHOLDER),.05)
  1.  . . . . I COVERAGE="" D PCOV^AGAGERP2
  1.  . . . I WFLG="W" D
  1.  . . . . S PNAME=$$GET1^DIQ(9999999.18,$E(PRVTNO,3,99),.01)
  1.  . . . . S COVERAGE="WORKMEN'S COMP"
  1.  . . . I WFLG="M" D
  1.  . . . . S MCDNUM=$E(PRVTNO,3,99)
  1.  . . . . S PNUMB=$$GET1^DIQ(9000004,MCDNUM,.03)
  1.  . . . . S PLAN=$$GET1^DIQ(9000004,MCDNUM,.11)
  1.  . . . . S MSTATE=$$GET1^DIQ(9000004,MCDNUM,.04,"I")
  1.  . . . . S MSTATE=$$GET1^DIQ(5,MSTATE,1)
  1.  . . . . I MSTATE'="" S PNAME=MSTATE_" "_PLAN
  1.  . . . . I MSTATE="" S PNAME=PLAN
  1.  . . . . I PNUMB'="" D DCOV^AGAGERP2
  1.  . . . W !,PATNAM," (",$G(CHRTNO),")(" S CHARCNT=CHARCNT+$L(PATNAM)+$L(CHRTNO)+4
  1.  . . . I AGE["MOS" W AGE,")" S CHARCNT=CHARCNT+$L(AGE)+1
  1.  . . . I AGE'["MOS" W +AGE,")" S CHARCNT=CHARCNT+$L(+AGE)+1
  1.  . . . I CHARCNT<35 W ?35,$G(PNUMB)
  1.  . . . W ?53,$E($G(PNAME),1,26)
  1.  . . . W !,?10,$G(ADDR1)
  1.  . . . I CHARCNT>34 W ?35,$G(PNUMB)
  1.  . . . W ?53,$G(COVERAGE)
  1.  . . . I $G(ADDR2)'="" W !,?10,$G(ADDR2)
  1.  . . . W !,?10,$G(CITY)," ",$G(ST)," ",$G(ZIP)
  1.  . . . W !,$G(LASTUPD)
  1.  . . . W !,AGLINE("DASH") S LINECT=LINECT+7
  1.  . . . S AGTOTAL=$G(AGTOTAL)+1
  1.  . . . I $E(IOST)="C",$Y>(IOSL-5) K DIR D RTRN^AG S ESCAPE=X=U D:'ESCAPE PRVTHDR^AGAGERP2
  1.  . . . I $E(IOST)'="C",$Y>(IOSL-17) W !! D PRVTHDR^AGAGERP2
  1.  W !,"TOTAL RECORDS:",?20,$G(AGTOTAL),!!
  1.  I $E(IOST)="C",PATNAM="" K DIR D RTRN^AG
  1.  I $E(IOST)'="C" D CLOSE^%ZISH(IO)
  1.  Q
  1.  ;
  1. GETPATN ; Get Specific Patient
  1.  N PATNAM,PATNUM,PATNUM,SEL,AGINSLP,EFF,END,AGALTRES,PLAN,ARPLNTYP,ARNTYP,AGSEENLY,FOUND
  1.  S PATNUM=+$G(EXCL("Specific Patient"))
  1.  S PATNAM=$$GET1^DIQ(2,PATNUM,.01)
  1.  Q:(+PATNUM=0)!(PATNAM="")
  1.  S ^TMP("AGAGERP",$J)="",^TMP("AGAGERP",$J,PATNAM,PATNUM)=""
  1.  K AGINS,AGINSN1,AGINSNN
  1.  S SEL=0
  1.  I $G(EXCL("Elig Date Range"))'="" S AGSEENLY=1
  1.  S AGALTRES=$P($G(EXCL("Alternate Resource")),U,2)
  1.  I (AGALTRES="MEDICARE")!(AGALTRES="") D FINDMCR^AGINS(PATNUM),FINDRRE^AGINS(PATNUM)
  1.  I (AGALTRES="")!(AGALTRES="MEDICAID")!(AGALTRES="CHIP") D FINDMCD^AGINS(PATNUM)
  1.  I (AGALTRES="")!(AGALTRES["PRIVATE") D FINDPVT^AGINS(PATNUM)
  1.  K EFF,END,PLAN,ARNOTYP
  1.  S AGINSLP=0
  1.  F  S AGINSLP=$O(AGINS(AGINSLP)) Q:AGINSLP=""  D
  1.  . S ARNOTYP=$P(AGINS(AGINSLP),U,10)
  1.  . I AGALTRES="MEDICAID",ARNOTYP="D" D
  1.  . . S PLAN=$P(AGINS(AGINSLP),U,12)
  1.  . . I PLAN'="" D
  1.  . . . ;S ARPLNTYP=$$GET1^DIQ(9999999.18,PLAN,.21,"I")
  1.  . . . S ARPLNTYP=$$INSTYP^AGUTL(PLAN)  ;IHS/OIT/NKD AG*7.1*12
  1.  . . . I ARPLNTYP="K",AGALTRES="MEDICAID" K AGINS(AGINSLP) Q
  1.  . . . I ARPLNTYP'="K",AGALTRES="CHIP" K AGINS(AGINSLP) Q
  1.  . I $D(AGINS(AGINSLP)) D
  1.  . . S EFF=$P(AGINS(AGINSLP),U,5)
  1.  . . S END=$P(AGINS(AGINSLP),U,6)
  1.  . . S FOUND=0
  1.  . . I $G(EXCL("Elig Date Range"))'="" D ELGDTCH^AGAGERP1(EFF,END,.FOUND)
  1.  . . I $G(EXCL("Elig Date Range"))="" D ELGDTCH2^AGAGERP1(EFF,END,.FOUND)
  1.  . . I 'FOUND K AGINS(AGINSLP)
  1.  Q