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)
End DoDot:2
End DoDot:1
+29 WRITE !,PATNAM," (",CHRTNO,")"
+30 SET ARNO=$ORDER(AGINS(0))
+31 IF ARNO'=""
IF $DATA(AGINS)
Begin DoDot:1
+32 IF AGE["MOS"
WRITE " (",AGE,")"
+33 IF AGE'["MOS"
WRITE " (",+AGE,")"
+34 IF ARNO'=""
IF $DATA(AGINS(ARNO))
Begin DoDot:2
+35 DO AGARNO
End DoDot:2
End DoDot:1
+36 IF '$DATA(AGINS)
WRITE ?51,PHONE
+37 WRITE !,?10,ADDR1
+38 IF '$DATA(AGINS)
Begin DoDot:1
+39 WRITE ?51,DOB
+40 IF AGE["MOS"
WRITE " (",AGE,")"
+41 IF AGE'["MOS"
WRITE " (",+AGE,")"
End DoDot:1
+42 IF ARNO'=""
IF $DATA(AGINS(ARNO))
DO AGARNO
+43 IF $GET(ADDR2)'=""
WRITE !,?10,ADDR2
IF ARNO'=""
IF $DATA(AGINS(ARNO))
DO AGARNO
+44 IF $GET(ADDR3)'=""
WRITE !,?10,ADDR3
IF ARNO'=""
IF $DATA(AGINS(ARNO))
DO AGARNO
+45 WRITE !,?10,CITY," ",ST," ",ZIP
IF ARNO'=""
IF $DATA(AGINS(ARNO))
DO AGARNO
+46 IF '$DATA(AGINS)
Begin DoDot:1
+47 WRITE !,LASTUPD,?51,$GET(APPSTAT)
+48 IF $GET(APPSTDT)'=""
WRITE "/",$GET(APPSTDT)
End DoDot:1
+49 IF $DATA(AGINS)
Begin DoDot:1
+50 WRITE !,LASTUPD
End DoDot:1
+51 IF ARNO'=""
IF $DATA(AGINS(ARNO))
DO AGARNO
+52 IF ARNO'=""
IF $DATA(AGINS(ARNO))
FOR I=ARNO:1
IF '$DATA(AGINS(I))
QUIT
WRITE !
DO AGARNO
+53 IF $GET(EXCL("Alternate Resource"))=""!($GET(EXCL("Alternate Resource"))["NO RESOURCES")
Begin DoDot:1
+54 IF '$DATA(AGINS)
IF $GET(APPSTAT)=""
WRITE ?51,"No Alternate Resources"
+55 IF '$DATA(AGINS)
IF $GET(APPSTAT)'=""
WRITE !,?51,"No Alternate Resources"
End DoDot:1
+56 IF $GET(EXCL("Alternate Resource"))'=""
IF ($GET(EXCL("Alternate Resource"))'["NO RESOURCES")
Begin DoDot:1
+57 IF '$DATA(AGINS)
IF $GET(APPSTAT)=""
WRITE ?51,"Resource Not Found"
+58 IF '$DATA(AGINS)
IF $GET(APPSTAT)'=""
WRITE !,?51,"Resource Not Found"
End DoDot:1
+59 WRITE !,AGLINE("EQ")
SET LINECT=LINECT+7
+60 IF $EXTRACT(IOST)="C"
IF $Y>(IOSL-5)
KILL DIR
DO RTRN^AG
SET ESCAPE=X=U
IF 'ESCAPE
DO HDR
+61 IF $EXTRACT(IOST)'="C"
IF $Y>(IOSL-17)
WRITE !!
DO HDR
+62 IF $EXTRACT(IOST)="C"
KILL DIR
DO RTRN^AG
+63 IF $EXTRACT(IOST)'="C"
DO CLOSE^%ZISH(IO)
+64 QUIT
+65 ;
HDRTOP ; Top of Header
+1 SET LINECT=11
+2 IF $EXTRACT(IOST)'="C"
IF PAGENO>0
WRITE @IOF
+3 IF $EXTRACT(IOST)="C"
WRITE @IOF
+4 SET PAGENO=PAGENO+1
+5 IF $GET(EXCL("Age Range"))=""
SET EXCL("Age Range")="^ALL"
+6 WRITE !,$$GET1^DIQ(200,DUZ,.01)
+7 NEW HOMESIT
SET HOMESIT=$$GET1^DIQ(4,DUZ(2),.01)
+8 WRITE ?(80-$LENGTH(HOMESIT))/2,HOMESIT
+9 WRITE ?69,"Page ",PAGENO
+10 IF $DATA(EXCL("Age Range"))
WRITE !,?(53-$LENGTH($PIECE(EXCL("Age Range"),"^",2))/2),"Active Patients Age Range: ",$PIECE(EXCL("Age Range"),"^",2)
+11 IF $DATA(EXCL("Alternate Resource"))
WRITE !,?(60-$LENGTH($PIECE(EXCL("Alternate Resource"),"^",2))/2),"Alternate Resource: ",$PIECE(EXCL("Alternate Resource"),"^",2)
+12 IF $DATA(EXCL("Location"))
WRITE !,?(70-$LENGTH($PIECE($GET(EXCL("Location")),"^",2))/2),"Location: ",$PIECE($GET(EXCL("Location")),"^",2)
+13 IF $DATA(EXCL("Visit Date Range"))
WRITE !,?18,"Visit Date Range: ",$PIECE($GET(EXCL("Visit Date Range")),"^",2)," - ",$PIECE($GET(EXCL("Visit Date Range")),"^",4)
+14 IF $DATA(EXCL("Elig Date Range"))
WRITE !,?18,"Elig Date Range: ",$PIECE($GET(EXCL("Elig Date Range")),"^",2)," - ",$PIECE($GET(EXCL("Elig Date Range")),"^",4)
+15 IF $DATA(EXCL("Eligibility Status"))
WRITE !,?(60-$LENGTH($PIECE($GET(EXCL("Eligibility Status")),"^",2))/2),"Eligibility Status: ",$PIECE($GET(EXCL("Eligibility Status")),"^",2)
+16 IF $DATA(EXCL("Specific Patient"))
WRITE !,?(65-$LENGTH($PIECE($GET(EXCL("Specific Patient")),"^",2))/2),"Specific Patient: ",$PIECE($GET(EXCL("Specific Patient")),"^",2)
+17 IF $DATA(EXCL("Specific Insurer"))
WRITE !,?(65-$LENGTH($PIECE($GET(EXCL("Specific Insurer")),"^",2))/2),"Specific Insurer: ",$PIECE($GET(EXCL("Specific Insurer")),"^",2)
+18 WRITE !,?23,"Report Date: ",RPTDT
+19 WRITE !
+20 QUIT
+21 ;
HDR ; Report Header
+1 DO HDRTOP
+2 WRITE !,"Name (CHART #)",?51,"HOME PHONE"
+3 WRITE !,"ADDRESS",?51,"DATE OF BIRTH (AGE)"
+4 WRITE !,"DATE OF LAST UPDATE",?51,"APPLICATION STATUS/DATE"
+5 WRITE !,AGLINE("EQ")
+6 QUIT
+7 ;
HDR2 ; Report Header for Specific Patient with Qualifying Alt. Resources
+1 DO HDRTOP
+2 WRITE !,"Name (CHART #) (AGE)"
+3 WRITE !,"ADDRESS"
+4 WRITE !,"DATE OF LAST UPDATE",?40,"Alternate Resource",?62,"Policy #/Coverage"
+5 WRITE !,AGLINE("EQ")
+6 QUIT
+7 ;
MRHDR ; MEDICARE Report Header
+1 DO HDRTOP
+2 WRITE !,"Name (CHART #)(AGE)",?47,"MEDICARE(M)"
+3 WRITE !,"DATE OF LAST UPDATE",?47,"RAILROAD(R)",?69,"COVERAGE"
+4 WRITE !,AGLINE("EQ")
+5 QUIT
+6 ;
MDHDR ; MEDICAID Report Header
+1 DO HDRTOP
+2 WRITE !,"Name (CHART #)(AGE)",?35,"MEDICAID (STATE)",?55,"PLAN NAME"
+3 WRITE !,"DATE OF LAST UPDATE",?55,"COVERAGE TYPE"
+4 WRITE !,AGLINE("EQ")
+5 QUIT
+6 ;
PRVTHDR ; Private Report Header
+1 DO HDRTOP
+2 WRITE !,"Name (CHART #)(AGE)",?35,"POLICY NUMBER",?53,"INSURER"
+3 WRITE !,"DATE OF LAST UPDATE",?53,"COVERAGE TYPE"
+4 WRITE !,AGLINE("EQ")
+5 QUIT
+6 ;
MCOV ; Get Medicare Coverage
+1 NEW IEN,NODE,FROMDT,TODT,COV,COV1,ELGFR,ELGTO
+2 SET IEN=0
SET COVERAGE=""
+3 FOR
SET IEN=$ORDER(^AUPNMCR(MCRNUM,11,IEN))
IF (IEN="B")!(IEN="")
QUIT
Begin DoDot:1
+4 SET NODE=$GET(^AUPNMCR(MCRNUM,11,IEN,0))
+5 IF NODE'=""
Begin DoDot:2
+6 IF '$DATA(EXCL("Elig Date Range"))
Begin DoDot:3
+7 SET FROMDT=$PIECE(NODE,U)
SET TODT=$PIECE(NODE,U,2)
+8 IF TODT=""
SET TODT=9999999
+9 IF '((TODT<DT)!(DT<FROMDT))
Begin DoDot:4
+10 SET COV1=$PIECE(NODE,U,3)
+11 IF COV1'=""
SET COV(COV1)=""
End DoDot:4
End DoDot:3
+12 IF $DATA(EXCL("Elig Date Range"))
Begin DoDot:3
+13 SET ELGFR=$PIECE($GET(EXCL("Elig Date Range")),U)
SET ELGTO=$PIECE($GET(EXCL("Elig Date Range")),U,3)
+14 SET FROMDT=$PIECE(NODE,U)
SET TODT=$PIECE(NODE,U,2)
+15 IF TODT=""
SET TODT=9999999
+16 IF '((TODT<ELGFR)!(ELGTO<FROMDT))
Begin DoDot:4
+17 SET COV1=$PIECE(NODE,U,3)
+18 IF COV1'=""
SET COV(COV1)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 SET COV1=""
+20 FOR
SET COV1=$ORDER(COV(COV1))
IF COV1=""
QUIT
SET COVERAGE=COVERAGE_"/"_COV1
+21 SET COVERAGE=$EXTRACT(COVERAGE,2,($LENGTH(COVERAGE)))
+22 QUIT
+23 ;
PCOV ; Get Private Insurance Coverage
+1 NEW FROMDT,TODT,COV,COV1,ELGFR,ELGTO
+2 SET COVERAGE=""
+3 SET NODE=$GET(^AUPNPRVT(PATIEN,11,+PNODE,0))
+4 IF NODE'=""
Begin DoDot:1
+5 IF '$DATA(EXCL("Elig Date Range"))
Begin DoDot:2
+6 SET FROMDT=$PIECE(NODE,U,6)
SET TODT=$PIECE(NODE,U,7)
+7 IF TODT=""
SET TODT=9999999
+8 IF '((TODT<DT)!(DT<FROMDT))
Begin DoDot:3
+9 SET COV1=$PIECE(NODE,U,3)
+10 IF COV1'=""
SET COVERAGE=$$GET1^DIQ(9999999.65,COV1,.01)
End DoDot:3
End DoDot:2
+11 IF $DATA(EXCL("Elig Date Range"))
Begin DoDot:2
+12 SET ELGFR=$PIECE($GET(EXCL("Elig Date Range")),U)
SET ELGTO=$PIECE($GET(EXCL("Elig Date Range")),U,3)
+13 SET FROMDT=$PIECE(NODE,U,6)
SET TODT=$PIECE(NODE,U,7)
+14 IF TODT=""
SET TODT=9999999
+15 IF '((TODT<ELGFR)!(ELGTO<FROMDT))
Begin DoDot:3
+16 SET COV1=$PIECE(NODE,U,3)
+17 IF COV1'=""
SET COVERAGE=$$GET1^DIQ(9999999.65,COV1,.01)
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
DCOV ; Get Medicaid Coverage
+1 NEW IEN,NODE,FROMDT,TODT,COV,COV1,ELGFR,ELGTO
+2 SET IEN=0
SET COVERAGE=""
+3 FOR
SET IEN=$ORDER(^AUPNMCD(MCDNUM,11,IEN))
IF (IEN="B")!(IEN="")
QUIT
Begin DoDot:1
+4 SET NODE=$GET(^AUPNMCD(MCDNUM,11,IEN,0))
+5 IF NODE'=""
Begin DoDot:2
+6 IF '$DATA(EXCL("Elig Date Range"))
Begin DoDot:3
+7 SET FROMDT=$PIECE(NODE,U)
SET TODT=$PIECE(NODE,U,2)
+8 IF TODT=""
SET TODT=9999999
+9 IF '((TODT<DT)!(DT<FROMDT))
Begin DoDot:4
+10 SET COV1=$PIECE(NODE,U,3)
+11 IF COV1'=""
SET COV(COV1)=""
End DoDot:4
End DoDot:3
+12 IF $DATA(EXCL("Elig Date Range"))
Begin DoDot:3
+13 SET ELGFR=$PIECE($GET(EXCL("Elig Date Range")),U)
SET ELGTO=$PIECE($GET(EXCL("Elig Date Range")),U,3)
+14 SET FROMDT=$PIECE(NODE,U)
SET TODT=$PIECE(NODE,U,2)
+15 IF TODT=""
SET TODT=9999999
+16 IF '((TODT<ELGFR)!(ELGTO<FROMDT))
Begin DoDot:4
+17 SET COV1=$PIECE(NODE,U,3)
+18 IF COV1'=""
SET COV(COV1)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 SET COV1=""
+20 FOR
SET COV1=$ORDER(COV(COV1))
IF COV1=""
QUIT
SET COVERAGE=COVERAGE_"/"_COV1
+21 SET COVERAGE=$EXTRACT(COVERAGE,2,($LENGTH(COVERAGE)))
+22 QUIT
+23 ;
RCOV ; Get Railroad Coverage
+1 ;N IEN,NODE,FROMDT,TODT,COV,COV1,ELGFR,ELGTO,COVERAGE ;IHS/OIT/NKD AG*7.1*14 REMOVED LOCAL SCOPE OF COVERAGE
+2 NEW IEN,NODE,FROMDT,TODT,COV,COV1,ELGFR,ELGTO
+3 SET IEN=0
SET COVERAGE=""
+4 FOR
SET IEN=$ORDER(^AUPNRRE(MCRNUM,11,IEN))
IF (IEN="B")!(IEN="")
QUIT
Begin DoDot:1
+5 SET NODE=$GET(^AUPNRRE(MCRNUM,11,IEN,0))
+6 IF NODE'=""
Begin DoDot:2
+7 IF '$DATA(EXCL("Elig Date Range"))
Begin DoDot:3
+8 SET FROMDT=$PIECE(NODE,U)
SET TODT=$PIECE(NODE,U,2)
+9 IF TODT=""
SET TODT=9999999
+10 IF '((TODT<DT)!(DT<FROMDT))
Begin DoDot:4
+11 SET COV1=$PIECE(NODE,U,3)
+12 IF COV1'=""
SET COV(COV1)=""
End DoDot:4
End DoDot:3
+13 IF $DATA(EXCL("Elig Date Range"))
Begin DoDot:3
+14 SET ELGFR=$PIECE($GET(EXCL("Elig Date Range")),U)
SET ELGTO=$PIECE($GET(EXCL("Elig Date Range")),U,3)
+15 SET FROMDT=$PIECE(NODE,U)
SET TODT=$PIECE(NODE,U,2)
+16 IF TODT=""
SET TODT=9999999
+17 IF '((TODT<ELGFR)!(ELGTO<FROMDT))
Begin DoDot:4
+18 SET COV1=$PIECE(NODE,U,3)
+19 IF COV1'=""
SET COV(COV1)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+20 SET COV1=""
+21 FOR
SET COV1=$ORDER(COV(COV1))
IF COV1=""
QUIT
SET COVERAGE=COVERAGE_"/"_COV1
+22 SET COVERAGE=$EXTRACT(COVERAGE,2,($LENGTH(COVERAGE)))
+23 QUIT
+24 ;
HDRCHK ; Check AGINS agains the users selections
+1 IF $GET(EXCL("Alternate Resource"))=""!($GET(EXCL("Alternate Resource"))["NO RESOURCES")
QUIT
+2 NEW ARNO,ARVAL,ARNOTYP
+3 SET ARNO=0
+4 SET ARVAL=$PIECE(EXCL("Alternate Resource"),U,2)
+5 FOR
SET ARNO=$ORDER(AGINS(ARNO))
IF ARNO=""
QUIT
Begin DoDot:1
+6 SET ARNOTYP=$PIECE(AGINS(ARNO),U,10)
+7 IF (ARVAL["MEDICARE")&(ARNOTYP'="M")&(ARNOTYP'="R")
KILL AGINS(ARNO)
+8 IF (ARVAL["MEDICAID")&(ARNOTYP'="D")
KILL AGINS(ARNO)
+9 IF (ARVAL["PRIVATE")&(ARNOTYP'="P")
KILL AGINS(ARNO)
End DoDot:1
+10 QUIT
+11 ;
AGARNO ; Get Alternate Resource Information
+1 NEW ARINS,ARNAME,ARCOV,ARPOLNO,ARNOTYP,PLAN,ARPLNTYP,ARINS,AGMCD,AGST
+2 SET ARINS=$PIECE(AGINS(ARNO),U,2)
+3 SET ARNAME=$$GET1^DIQ(9999999.18,ARINS,.01)
+4 SET ARCOV=$PIECE(AGINS(ARNO),U,4)
+5 SET ARPOLNO=$PIECE(AGINS(ARNO),U,9)
+6 SET ARNOTYP=$PIECE(AGINS(ARNO),U,10)
+7 IF ARNOTYP="D"
Begin DoDot:1
+8 SET PLAN=$PIECE(AGINS(ARNO),U,12)
+9 IF PLAN'=""
Begin DoDot:2
+10 ;S ARPLNTYP=$$GET1^DIQ(9999999.18,PLAN,.21,"I")
+11 ;IHS/OIT/NKD AG*7.1*12
SET ARPLNTYP=$$INSTYP^AGUTL(PLAN)
+12 IF ARPLNTYP="K"
Begin DoDot:3
+13 SET ARNAME=$$GET1^DIQ(9999999.18,PLAN,.01)
+14 SET ARNOTYP="K"
+15 SET AGMCD=$EXTRACT($PIECE($GET(AGINS(ARNO)),U,7),2,99)
+16 IF AGMCD'=""
SET AGST=$PIECE($GET(^AUPNMCD(AGMCD,0)),U,4)
+17 IF $GET(AGST)'=""
SET AGST=$PIECE($GET(^DIC(5,AGST,0)),U,2)
+18 IF $GET(AGST)'=""
SET ARNAME=AGST_" "_ARNAME
End DoDot:3
End DoDot:2
End DoDot:1
+19 WRITE ?40,$EXTRACT(ARNAME,1,21)
+20 IF ARNOTYP="R"!(ARNOTYP="M")
WRITE ?62,ARNOTYP,"-",$EXTRACT(ARPOLNO,1,18)
+21 IF (ARNOTYP'="R")&(ARNOTYP'="M")
WRITE ?62,$EXTRACT(ARPOLNO,1,18)
+22 IF $GET(ARCOV)'=""
Begin DoDot:1
+23 WRITE "/"
+24 IF $X>(80-$LENGTH(ARCOV))
WRITE !
+25 WRITE ?62,$EXTRACT(ARCOV,1,18)
End DoDot:1
+26 SET ARNO=$ORDER(AGINS(ARNO))
+27 QUIT
