AGAGERP2.m

AGAGERP2 ;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 BUG FIX PREVENTING RRE COVERAGE

 ;

PRINT ; Print the report

 I $D(^TMP("AGAGERP",$J))<11 W !,"No Records Found!" H 2 Q

 N RPTDT,POP,%H,X,Y,AGLOC,AGLINE

 S %H=$H D YX^%DTC S RPTDT=Y

 S $P(AGLINE("EQ"),"=",80)=""

 S $P(AGLINE("DASH"),"-",80)=""

 ;

START ; Begin the output process

 I $G(AGIO)="" U IO

 I $G(EXCL("Specific Patient"))'="" D PRTPNT Q

 I $G(EXCL("Alternate Resource"))["MEDICARE" D PRTMEDC^AGAGERP3 Q

 I $G(EXCL("Alternate Resource"))["MEDICAID" D PRTMEDD^AGAGERP3 Q

 I $G(EXCL("Alternate Resource"))["CHIP" D PRTPRVT^AGAGERP3 Q

 I $G(EXCL("Alternate Resource"))["PRIVATE INSURANCE" D PRTPRVT^AGAGERP3 Q

 I $G(EXCL("Alternate Resource"))["PRIVATE + WORK" D PRTPRVT^AGAGERP3 Q

 I $G(EXCL("Alternate Resource"))["SPECIFIC INSURER" D PRTPRVT^AGAGERP3 Q

 D PRTNOAR

 Q

 ;

PRTNOAR ; Print for selections without an Alternate Resource

 N PAGENO,PATNUM,PATIEN,LINECT,ESCAPE,PATNAM,AGTOTAL

 S (PAGENO,ESCAPE,AGTOTAL)=0

 D HDR

 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

 . . N CHRTNO,PHONE,ADDR1,ADDR2,ADDR3,CITY,ST,ZIP,DOB,LASTUPD,APPSTAT,APPSTDT,APPNODE,STABB,AGE

 . . S CHRTNO=$P($G(^AUPNPAT(PATIEN,41,DUZ(2),0)),U,2)

 . . S PHONE=$$GET1^DIQ(2,PATIEN,.131)

 . . 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 APPNODE=$O(^AUPNAPPS("B",PATIEN,""))

 . . I APPNODE'="" D

 . . . S APPNOD2=""

 . . . F  S APPNOD2=$O(^AUPNAPPS(APPNODE,11,APPNOD2))  Q:($O(^AUPNAPPS(APPNODE,11,APPNOD2))="B")!(APPNOD2="")

 . . . I APPNOD2'="" D

 . . . . S APPSTDT=$$GET1^DIQ(9000045.11,APPNOD2_","_APPNODE,.01)

 . . . . S APPSTAT=$$GET1^DIQ(9000045.11,APPNOD2_","_APPNODE,.04)

 . . W !,PATNAM," (",CHRTNO,")",?51,PHONE

 . . W !,?10,ADDR1,?51,DOB," ("

 . . I AGE["MOS" W AGE,")"

 . . I AGE'["MOS" W +AGE,")"

 . . I $G(ADDR2)'="" W !,?10,ADDR2

 . . I $G(ADDR3)'="" W !,?10,ADDR3

 . . W !,?10,CITY," ",ST," ",ZIP

 . . W !,LASTUPD,?51,$G(APPSTAT)

 . . I $G(APPSTDT)'="" W "/",$G(APPSTDT)

 . . W !,AGLINE("DASH") S LINECT=LINECT+11

 . . S AGTOTAL=$G(AGTOTAL)+1

 . . I $E(IOST)="C",$Y>(IOSL-5) K DIR D RTRN^AG S ESCAPE=X=U D:'ESCAPE HDR

 . . I $E(IOST)'="C",$Y>(IOSL-17) W !! D HDR

 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

 ;

PRTPNT ; Print Specific Patient

 N PAGENO,PATNUM,PATIEN,LINECT,ESCAPE,PATNAM,I

 S PAGENO=0,ESCAPE=0

 D HDRCHK

 I '$D(AGINS) D HDR

 I $D(AGINS) D HDR2

 S PATNAM=$P(EXCL("Specific Patient"),"^",2)

 S PATIEN=+EXCL("Specific Patient")

 N CHRTNO,PHONE,ADDR1,ADDR2,ADDR3,CITY,ST,ZIP,DOB,LASTUPD

 N APPSTAT,APPSTDT,APPIEN,APPSTAT1,APPNODE,STABB,APPNOD2,AGE,ARNO

 S CHRTNO=$P($G(^AUPNPAT(PATIEN,41,DUZ(2),0)),U,2)

 S PHONE=$$GET1^DIQ(2,PATIEN,.131)

 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 APPNODE=$O(^AUPNAPPS("B",PATIEN,""))

 I APPNODE'="" D

 . S APPNOD2=""

 . F  S APPNOD2=$O(^AUPNAPPS(APPNODE,11,APPNOD2))  Q:($O(^AUPNAPPS(APPNODE,11,APPNOD2))="B")!(APPNOD2="")

 . I APPNOD2'="" D

 . . S APPSTDT=$$GET1^DIQ(9000045.11,APPNOD2_","_APPNODE,.01)

 . . S APPSTAT=$$GET1^DIQ(9000045.11,APPNOD2_","_APPNODE,.04)

 W !,PATNAM," (",CHRTNO,")"

 S ARNO=$O(AGINS(0))

 I ARNO'="",$D(AGINS) D

 . I AGE["MOS" W " (",AGE,")"

 . I AGE'["MOS" W " (",+AGE,")"

 . I ARNO'="",$D(AGINS(ARNO)) D

 . . D AGARNO

 I '$D(AGINS) W ?51,PHONE

 W !,?10,ADDR1

 I '$D(AGINS) D

 . W ?51,DOB

 . I AGE["MOS" W " (",AGE,")"

 . I AGE'["MOS" W " (",+AGE,")"

 I ARNO'="",$D(AGINS(ARNO)) D AGARNO

 I $G(ADDR2)'="" W !,?10,ADDR2 I ARNO'="",$D(AGINS(ARNO)) D AGARNO

 I $G(ADDR3)'="" W !,?10,ADDR3 I ARNO'="",$D(AGINS(ARNO)) D AGARNO

 W !,?10,CITY," ",ST," ",ZIP I ARNO'="",$D(AGINS(ARNO)) D AGARNO

 I '$D(AGINS) D

 . W !,LASTUPD,?51,$G(APPSTAT)

 . I $G(APPSTDT)'="" W "/",$G(APPSTDT)

 I $D(AGINS) D

 . W !,LASTUPD

 I ARNO'="",$D(AGINS(ARNO)) D AGARNO

 I ARNO'="",$D(AGINS(ARNO)) F I=ARNO:1 Q:'$D(AGINS(I))  W ! D AGARNO

 I $G(EXCL("Alternate Resource"))=""!($G(EXCL("Alternate Resource"))["NO RESOURCES") D

 . I '$D(AGINS),$G(APPSTAT)="" W ?51,"No Alternate Resources"

 . I '$D(AGINS),$G(APPSTAT)'="" W !,?51,"No Alternate Resources"

 I $G(EXCL("Alternate Resource"))'="",($G(EXCL("Alternate Resource"))'["NO RESOURCES") D

 . I '$D(AGINS),$G(APPSTAT)="" W ?51,"Resource Not Found"

 . I '$D(AGINS),$G(APPSTAT)'="" W !,?51,"Resource Not Found"

 W !,AGLINE("EQ") S LINECT=LINECT+7

 I $E(IOST)="C",$Y>(IOSL-5) K DIR D RTRN^AG S ESCAPE=X=U D:'ESCAPE HDR

 I $E(IOST)'="C",$Y>(IOSL-17) W !! D HDR

 I $E(IOST)="C" K DIR D RTRN^AG

 I $E(IOST)'="C" D CLOSE^%ZISH(IO)

 Q

 ;

HDRTOP ; Top of Header

 S LINECT=11

 I $E(IOST)'="C",PAGENO>0 W @IOF

 I $E(IOST)="C" W @IOF

 S PAGENO=PAGENO+1

 I $G(EXCL("Age Range"))="" S EXCL("Age Range")="^ALL"

 W !,$$GET1^DIQ(200,DUZ,.01)

 N HOMESIT S HOMESIT=$$GET1^DIQ(4,DUZ(2),.01)

 W ?(80-$L(HOMESIT))/2,HOMESIT

 W ?69,"Page ",PAGENO

 I $D(EXCL("Age Range")) W !,?(53-$L($P(EXCL("Age Range"),"^",2))/2),"Active Patients Age Range: ",$P(EXCL("Age Range"),"^",2)

 I $D(EXCL("Alternate Resource")) W !,?(60-$L($P(EXCL("Alternate Resource"),"^",2))/2),"Alternate Resource: ",$P(EXCL("Alternate Resource"),"^",2)

 I $D(EXCL("Location")) W !,?(70-$L($P($G(EXCL("Location")),"^",2))/2),"Location: ",$P($G(EXCL("Location")),"^",2)

 I $D(EXCL("Visit Date Range")) W !,?18,"Visit Date Range: ",$P($G(EXCL("Visit Date Range")),"^",2)," - ",$P($G(EXCL("Visit Date Range")),"^",4)

 I $D(EXCL("Elig Date Range")) W !,?18,"Elig Date Range: ",$P($G(EXCL("Elig Date Range")),"^",2)," - ",$P($G(EXCL("Elig Date Range")),"^",4)

 I $D(EXCL("Eligibility Status")) W !,?(60-$L($P($G(EXCL("Eligibility Status")),"^",2))/2),"Eligibility Status: ",$P($G(EXCL("Eligibility Status")),"^",2)

 I $D(EXCL("Specific Patient")) W !,?(65-$L($P($G(EXCL("Specific Patient")),"^",2))/2),"Specific Patient: ",$P($G(EXCL("Specific Patient")),"^",2)

 I $D(EXCL("Specific Insurer")) W !,?(65-$L($P($G(EXCL("Specific Insurer")),"^",2))/2),"Specific Insurer: ",$P($G(EXCL("Specific Insurer")),"^",2)

 W !,?23,"Report Date: ",RPTDT

 W !

 Q

 ;

HDR ; Report Header 

 D HDRTOP

 W !,"Name (CHART #)",?51,"HOME PHONE"

 W !,"ADDRESS",?51,"DATE OF BIRTH (AGE)"

 W !,"DATE OF LAST UPDATE",?51,"APPLICATION STATUS/DATE"

 W !,AGLINE("EQ")

 Q

 ;

HDR2 ; Report Header for Specific Patient with Qualifying Alt. Resources

 D HDRTOP

 W !,"Name (CHART #) (AGE)"

 W !,"ADDRESS"

 W !,"DATE OF LAST UPDATE",?40,"Alternate Resource",?62,"Policy #/Coverage"

 W !,AGLINE("EQ")

 Q

 ;

MRHDR ; MEDICARE Report Header

 D HDRTOP

 W !,"Name (CHART #)(AGE)",?47,"MEDICARE(M)"

 W !,"DATE OF LAST UPDATE",?47,"RAILROAD(R)",?69,"COVERAGE"

 W !,AGLINE("EQ")

 Q

 ;

MDHDR ; MEDICAID Report Header

 D HDRTOP

 W !,"Name (CHART #)(AGE)",?35,"MEDICAID (STATE)",?55,"PLAN NAME"

 W !,"DATE OF LAST UPDATE",?55,"COVERAGE TYPE"

 W !,AGLINE("EQ")

 Q

 ;

PRVTHDR ; Private Report Header

 D HDRTOP

 W !,"Name (CHART #)(AGE)",?35,"POLICY NUMBER",?53,"INSURER"

 W !,"DATE OF LAST UPDATE",?53,"COVERAGE TYPE"

 W !,AGLINE("EQ")

 Q

 ;

MCOV ; Get Medicare Coverage

 N IEN,NODE,FROMDT,TODT,COV,COV1,ELGFR,ELGTO

 S IEN=0,COVERAGE=""

 F  S IEN=$O(^AUPNMCR(MCRNUM,11,IEN)) Q:(IEN="B")!(IEN="")  D

 . S NODE=$G(^AUPNMCR(MCRNUM,11,IEN,0))

 . I NODE'="" D

 . . I '$D(EXCL("Elig Date Range")) D

 . . . S FROMDT=$P(NODE,U),TODT=$P(NODE,U,2)

 . . . I TODT="" S TODT=9999999

 . . . I '((TODT<DT)!(DT<FROMDT)) D

 . . . . S COV1=$P(NODE,U,3)

 . . . . I COV1'="" S COV(COV1)=""

 . . I $D(EXCL("Elig Date Range")) D

 . . . S ELGFR=$P($G(EXCL("Elig Date Range")),U),ELGTO=$P($G(EXCL("Elig Date Range")),U,3)

 . . . S FROMDT=$P(NODE,U),TODT=$P(NODE,U,2)

 . . . I TODT="" S TODT=9999999

 . . . I '((TODT<ELGFR)!(ELGTO<FROMDT)) D

 . . . . S COV1=$P(NODE,U,3)

 . . . . I COV1'="" S COV(COV1)=""

 S COV1=""

 F  S COV1=$O(COV(COV1)) Q:COV1=""  S COVERAGE=COVERAGE_"/"_COV1

 S COVERAGE=$E(COVERAGE,2,($L(COVERAGE)))

 Q

 ;

PCOV ; Get Private Insurance Coverage

 N FROMDT,TODT,COV,COV1,ELGFR,ELGTO

 S COVERAGE=""

 S NODE=$G(^AUPNPRVT(PATIEN,11,+PNODE,0))

 I NODE'="" D

 . I '$D(EXCL("Elig Date Range")) D

 . . S FROMDT=$P(NODE,U,6),TODT=$P(NODE,U,7)

 . . I TODT="" S TODT=9999999

 . . I '((TODT<DT)!(DT<FROMDT)) D

 . . . S COV1=$P(NODE,U,3)

 . . . I COV1'="" S COVERAGE=$$GET1^DIQ(9999999.65,COV1,.01)

 . I $D(EXCL("Elig Date Range")) D

 . . S ELGFR=$P($G(EXCL("Elig Date Range")),U),ELGTO=$P($G(EXCL("Elig Date Range")),U,3)

 . . S FROMDT=$P(NODE,U,6),TODT=$P(NODE,U,7)

 . . I TODT="" S TODT=9999999

 . . I '((TODT<ELGFR)!(ELGTO<FROMDT)) D

 . . . S COV1=$P(NODE,U,3)

 . . . I COV1'="" S COVERAGE=$$GET1^DIQ(9999999.65,COV1,.01)

 Q

 ;

DCOV ; Get Medicaid Coverage

 N IEN,NODE,FROMDT,TODT,COV,COV1,ELGFR,ELGTO

 S IEN=0,COVERAGE=""

 F  S IEN=$O(^AUPNMCD(MCDNUM,11,IEN)) Q:(IEN="B")!(IEN="")  D

 . S NODE=$G(^AUPNMCD(MCDNUM,11,IEN,0))

 . I NODE'="" D

 . . I '$D(EXCL("Elig Date Range")) D

 . . . S FROMDT=$P(NODE,U),TODT=$P(NODE,U,2)

 . . . I TODT="" S TODT=9999999

 . . . I '((TODT<DT)!(DT<FROMDT)) D

 . . . . S COV1=$P(NODE,U,3)

 . . . . I COV1'="" S COV(COV1)=""

 . . I $D(EXCL("Elig Date Range")) D

 . . . S ELGFR=$P($G(EXCL("Elig Date Range")),U),ELGTO=$P($G(EXCL("Elig Date Range")),U,3)

 . . . S FROMDT=$P(NODE,U),TODT=$P(NODE,U,2)

 . . . I TODT="" S TODT=9999999

 . . . I '((TODT<ELGFR)!(ELGTO<FROMDT)) D

 . . . . S COV1=$P(NODE,U,3)

 . . . . I COV1'="" S COV(COV1)=""

 S COV1=""

 F  S COV1=$O(COV(COV1)) Q:COV1=""  S COVERAGE=COVERAGE_"/"_COV1

 S COVERAGE=$E(COVERAGE,2,($L(COVERAGE)))

 Q

 ;

RCOV ; Get Railroad Coverage

 ;N IEN,NODE,FROMDT,TODT,COV,COV1,ELGFR,ELGTO,COVERAGE  ;IHS/OIT/NKD AG*7.1*14 REMOVED LOCAL SCOPE OF COVERAGE

 N IEN,NODE,FROMDT,TODT,COV,COV1,ELGFR,ELGTO

 S IEN=0,COVERAGE=""

 F  S IEN=$O(^AUPNRRE(MCRNUM,11,IEN)) Q:(IEN="B")!(IEN="")  D

 . S NODE=$G(^AUPNRRE(MCRNUM,11,IEN,0))

 . I NODE'="" D

 . . I '$D(EXCL("Elig Date Range")) D

 . . . S FROMDT=$P(NODE,U),TODT=$P(NODE,U,2)

 . . . I TODT="" S TODT=9999999

 . . . I '((TODT<DT)!(DT<FROMDT)) D

 . . . . S COV1=$P(NODE,U,3)

 . . . . I COV1'="" S COV(COV1)=""

 . . I $D(EXCL("Elig Date Range")) D

 . . . S ELGFR=$P($G(EXCL("Elig Date Range")),U),ELGTO=$P($G(EXCL("Elig Date Range")),U,3)

 . . . S FROMDT=$P(NODE,U),TODT=$P(NODE,U,2)

 . . . I TODT="" S TODT=9999999

 . . . I '((TODT<ELGFR)!(ELGTO<FROMDT)) D

 . . . . S COV1=$P(NODE,U,3)

 . . . . I COV1'="" S COV(COV1)=""

 S COV1=""

 F  S COV1=$O(COV(COV1)) Q:COV1=""  S COVERAGE=COVERAGE_"/"_COV1

 S COVERAGE=$E(COVERAGE,2,($L(COVERAGE)))

 Q

 ;

HDRCHK ; Check AGINS agains the users selections

 Q:$G(EXCL("Alternate Resource"))=""!($G(EXCL("Alternate Resource"))["NO RESOURCES")

 N ARNO,ARVAL,ARNOTYP

 S ARNO=0

 S ARVAL=$P(EXCL("Alternate Resource"),U,2)

 F  S ARNO=$O(AGINS(ARNO)) Q:ARNO=""  D

 . S ARNOTYP=$P(AGINS(ARNO),U,10)

 . I (ARVAL["MEDICARE")&(ARNOTYP'="M")&(ARNOTYP'="R") K AGINS(ARNO)

 . I (ARVAL["MEDICAID")&(ARNOTYP'="D") K AGINS(ARNO)

 . I (ARVAL["PRIVATE")&(ARNOTYP'="P") K AGINS(ARNO)

 Q

 ;

AGARNO ;  Get Alternate Resource Information

 N ARINS,ARNAME,ARCOV,ARPOLNO,ARNOTYP,PLAN,ARPLNTYP,ARINS,AGMCD,AGST

 S ARINS=$P(AGINS(ARNO),U,2)

 S ARNAME=$$GET1^DIQ(9999999.18,ARINS,.01)

 S ARCOV=$P(AGINS(ARNO),U,4)

 S ARPOLNO=$P(AGINS(ARNO),U,9)

 S ARNOTYP=$P(AGINS(ARNO),U,10)

 I ARNOTYP="D" D

 . S PLAN=$P(AGINS(ARNO),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" D

 . . . S ARNAME=$$GET1^DIQ(9999999.18,PLAN,.01)

 . . . S ARNOTYP="K"

 . . . S AGMCD=$E($P($G(AGINS(ARNO)),U,7),2,99)

 . . . I AGMCD'="" S AGST=$P($G(^AUPNMCD(AGMCD,0)),U,4)

 . . . I $G(AGST)'="" S AGST=$P($G(^DIC(5,AGST,0)),U,2)

 . . . I $G(AGST)'="" S ARNAME=AGST_" "_ARNAME

 W ?40,$E(ARNAME,1,21)

 I ARNOTYP="R"!(ARNOTYP="M") W ?62,ARNOTYP,"-",$E(ARPOLNO,1,18)

 I (ARNOTYP'="R")&(ARNOTYP'="M") W ?62,$E(ARPOLNO,1,18)

 I $G(ARCOV)'="" D

 . W "/"

 . I $X>(80-$L(ARCOV)) W !

 . W ?62,$E(ARCOV,1,18)

 S ARNO=$O(AGINS(ARNO))

 Q

AGAGERP2  ;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 BUG FIX PREVENTING RRE COVERAGE

 +5       ;

PRINT     ; Print the report

 +1        IF $DATA(^TMP("AGAGERP",$JOB))<11

               WRITE !,"No Records Found!"

               HANG 2

               QUIT 

 +2        NEW RPTDT,POP,%H,X,Y,AGLOC,AGLINE

 +3        SET %H=$HOROLOG

           DO YX^%DTC

           SET RPTDT=Y

 +4        SET $PIECE(AGLINE("EQ"),"=",80)=""

 +5        SET $PIECE(AGLINE("DASH"),"-",80)=""

 +6       ;

START     ; Begin the output process

 +1        IF $GET(AGIO)=""

               USE IO

 +2        IF $GET(EXCL("Specific Patient"))'=""

               DO PRTPNT

               QUIT 

 +3        IF $GET(EXCL("Alternate Resource"))["MEDICARE"

               DO PRTMEDC^AGAGERP3

               QUIT 

 +4        IF $GET(EXCL("Alternate Resource"))["MEDICAID"

               DO PRTMEDD^AGAGERP3

               QUIT 

 +5        IF $GET(EXCL("Alternate Resource"))["CHIP"

               DO PRTPRVT^AGAGERP3

               QUIT 

 +6        IF $GET(EXCL("Alternate Resource"))["PRIVATE INSURANCE"

               DO PRTPRVT^AGAGERP3

               QUIT 

 +7        IF $GET(EXCL("Alternate Resource"))["PRIVATE + WORK"

               DO PRTPRVT^AGAGERP3

               QUIT 

 +8        IF $GET(EXCL("Alternate Resource"))["SPECIFIC INSURER"

               DO PRTPRVT^AGAGERP3

               QUIT 

 +9        DO PRTNOAR

 +10       QUIT 

 +11      ;

PRTNOAR   ; Print for selections without an Alternate Resource

 +1        NEW PAGENO,PATNUM,PATIEN,LINECT,ESCAPE,PATNAM,AGTOTAL

 +2        SET (PAGENO,ESCAPE,AGTOTAL)=0

 +3        DO HDR

 +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                        NEW CHRTNO,PHONE,ADDR1,ADDR2,ADDR3,CITY,ST,ZIP,DOB,LASTUPD,APPSTAT,APPSTDT,APPNODE,STABB,AGE

 +9                        SET CHRTNO=$PIECE($GET(^AUPNPAT(PATIEN,41,DUZ(2),0)),U,2)

 +10                       SET PHONE=$$GET1^DIQ(2,PATIEN,.131)

 +11                       SET ADDR1=$$GET1^DIQ(2,PATIEN,.111)

 +12                       SET ADDR2=$$GET1^DIQ(2,PATIEN,.112)

 +13                       SET ADDR3=$$GET1^DIQ(2,PATIEN,.113)

 +14                       SET CITY=$$GET1^DIQ(2,PATIEN,.114)

 +15                       SET STABB=$$GET1^DIQ(2,PATIEN,.115,"I")

 +16                       SET ST=$$GET1^DIQ(5,STABB,1)

 +17                       SET ZIP=$$GET1^DIQ(2,PATIEN,.116)

 +18                       NEW Y

                           SET Y=$$GET1^DIQ(2,PATIEN,.03,"I")

                           DO DD^%DT

                           SET DOB=Y

 +19                       SET AGE=$$GET1^DIQ(9000001,PATIEN,1102.98)

 +20                       SET LASTUPD=$$GET1^DIQ(9000001,PATIEN,.03)

 +21                       SET APPNODE=$ORDER(^AUPNAPPS("B",PATIEN,""))

 +22                       IF APPNODE'=""

                               Begin DoDot:3

 +23                               SET APPNOD2=""

 +24                               FOR 

                                       SET APPNOD2=$ORDER(^AUPNAPPS(APPNODE,11,APPNOD2))

                                       IF ($ORDER(^AUPNAPPS(APPNODE,11,APPNOD2))="B")!(APPNOD2="")

                                           QUIT 

 +25                               IF APPNOD2'=""

                                       Begin DoDot:4

 +26                                       SET APPSTDT=$$GET1^DIQ(9000045.11,APPNOD2_","_APPNODE,.01)

 +27                                       SET APPSTAT=$$GET1^DIQ(9000045.11,APPNOD2_","_APPNODE,.04)

                                       End DoDot:4

                               End DoDot:3

 +28                       WRITE !,PATNAM," (",CHRTNO,")",?51,PHONE

 +29                       WRITE !,?10,ADDR1,?51,DOB," ("

 +30                       IF AGE["MOS"

                               WRITE AGE,")"

 +31                       IF AGE'["MOS"

                               WRITE +AGE,")"

 +32                       IF $GET(ADDR2)'=""

                               WRITE !,?10,ADDR2

 +33                       IF $GET(ADDR3)'=""

                               WRITE !,?10,ADDR3

 +34                       WRITE !,?10,CITY," ",ST," ",ZIP

 +35                       WRITE !,LASTUPD,?51,$GET(APPSTAT)

 +36                       IF $GET(APPSTDT)'=""

                               WRITE "/",$GET(APPSTDT)

 +37                       WRITE !,AGLINE("DASH")

                           SET LINECT=LINECT+11

 +38                       SET AGTOTAL=$GET(AGTOTAL)+1

 +39                       IF $EXTRACT(IOST)="C"

                               IF $Y>(IOSL-5)

                                   KILL DIR

                                   DO RTRN^AG

                                   SET ESCAPE=X=U

                                   IF 'ESCAPE

                                       DO HDR

 +40                       IF $EXTRACT(IOST)'="C"

                               IF $Y>(IOSL-17)

                                   WRITE !!

                                   DO HDR

                       End DoDot:2

               End DoDot:1

 +41       WRITE !,"TOTAL RECORDS:",?20,$GET(AGTOTAL),!!

 +42       IF $EXTRACT(IOST)="C"

               IF PATNAM=""

                   KILL DIR

                   DO RTRN^AG

 +43       IF $EXTRACT(IOST)'="C"

               DO CLOSE^%ZISH(IO)

 +44       QUIT 

 +45      ;

PRTPNT    ; Print Specific Patient

 +1        NEW PAGENO,PATNUM,PATIEN,LINECT,ESCAPE,PATNAM,I

 +2        SET PAGENO=0

           SET ESCAPE=0

 +3        DO HDRCHK

 +4        IF '$DATA(AGINS)

               DO HDR

 +5        IF $DATA(AGINS)

               DO HDR2

 +6        SET PATNAM=$PIECE(EXCL("Specific Patient"),"^",2)

 +7        SET PATIEN=+EXCL("Specific Patient")

 +8        NEW CHRTNO,PHONE,ADDR1,ADDR2,ADDR3,CITY,ST,ZIP,DOB,LASTUPD

 +9        NEW APPSTAT,APPSTDT,APPIEN,APPSTAT1,APPNODE,STABB,APPNOD2,AGE,ARNO

 +10       SET CHRTNO=$PIECE($GET(^AUPNPAT(PATIEN,41,DUZ(2),0)),U,2)

 +11       SET PHONE=$$GET1^DIQ(2,PATIEN,.131)

 +12       SET ADDR1=$$GET1^DIQ(2,PATIEN,.111)

 +13       SET ADDR2=$$GET1^DIQ(2,PATIEN,.112)

 +14       SET ADDR3=$$GET1^DIQ(2,PATIEN,.113)

 +15       SET CITY=$$GET1^DIQ(2,PATIEN,.114)

 +16       SET STABB=$$GET1^DIQ(2,PATIEN,.115,"I")

 +17       SET ST=$$GET1^DIQ(5,STABB,1)

 +18       SET ZIP=$$GET1^DIQ(2,PATIEN,.116)

 +19       NEW Y

           SET Y=$$GET1^DIQ(2,PATIEN,.03,"I")

           DO DD^%DT

           SET DOB=Y

 +20       SET AGE=$$GET1^DIQ(9000001,PATIEN,1102.98)

 +21       SET LASTUPD=$$GET1^DIQ(9000001,PATIEN,.03)

 +22       SET APPNODE=$ORDER(^AUPNAPPS("B",PATIEN,""))

 +23       IF APPNODE'=""

               Begin DoDot:1

 +24               SET APPNOD2=""

 +25               FOR 

                       SET APPNOD2=$ORDER(^AUPNAPPS(APPNODE,11,APPNOD2))

                       IF ($ORDER(^AUPNAPPS(APPNODE,11,APPNOD2))="B")!(APPNOD2="")

                           QUIT 

 +26               IF APPNOD2'=""

                       Begin DoDot:2

 +27                       SET APPSTDT=$$GET1^DIQ(9000045.11,APPNOD2_","_APPNODE,.01)

 +28                       SET APPSTAT=$$GET1^DIQ(9000045.11,APPNOD2_","_APPNODE,.04)