AGRPTINS ; IHS/SD/TPF - REPORT OF TOP 'N' INSURERS
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
;RUN A REPORT TO LIST THE TOP INSURERS THAT HAVE OPEN ELIGBILITY
;AT A SPECIFIC POINT IN TIME.
;I.E. ASK FOR A SPECIFIC POINT IN TIME
;GO THROUGH THE PRIVATE ELIGIBILITY,MEDICAID,MEDICARE FILE AND
;FIND INSURERS THAT ARE ACTIVE. LET USER CHOOSE TO DISREGARD NON
;ACTIVE PATIENTS. ALLOW USER TO CHOOSE HOW MANY TOP INSURERS TO
;LIST
;
EN ;EP
S ROUTNAME=$P($T(+1)," ")
S:$G(AGLINE("EQ"))="" $P(AGLINE("EQ"),"=",81)=""
D HDR
ASKFAC ;EP - ASK FOR A SPECIFIC FACILITY OR ALL
K DIR,DTOUT,DUOUT,DIRUT,DIROUT,TARFAC
S DIR("A")="Check for which Facility: All//"
S DIR(0)="POA^9999999.06:EMZ"
D ^DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) D EXIT Q
I X="" S TARFAC="ALL"
E S TARFAC=+Y
K DIR
ASKDT ;EP - ASK FOR THE 'POINT IN TIME'
W !!
K DIR,DTOUT,DUOUT,DIRUT,DIROUT
S DIR("A")="Date for the point in Time want eligibility for"
S DIR(0)="DO"
D ^DIR
G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) ASKFAC
S TARDATE=Y
K DIR
ASKACTPT ;EP - ASK WHETHER TO DISREGARD NON-ACTIVE PATIENTS
K DIR,DTOUT,DUOUT,DIRUT,DIROUT
S DIR("A")="Want to check if patient is active? "
S DIR(0)="YOA"
D ^DIR
G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) ASKDT
S NONACT=+Y ;IF TRUE THEN DO NOT COUNT NON-ACTIVE PATIENTS
K DIR
ASKENTRY ;EP
K DIR,DTOUT,DUOUT,DIRUT,DIROUT
S DIR("A")="How many entries do you want in the list"
S DIR("B")=20
S DIR(0)="NO^5:100"
D ^DIR
G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) ASKACTPT
S MAXDISP=+Y
K DIR
D NOW^%DTC S Y=% D DD^%DT S REPTIME=Y
D ASKDEV
G:POP EN
I $G(IO("Q")) D QUE Q
U IO
S PAGENO=0
D RUN(TARDATE,NONACT)
D ^%ZISC
G EN
RUN(TARDATE,NONACT) ;EP
;IF REPTIME IS NULL THEN TASKMAN IS CALLING
I $G(REPTIME)="" D NOW^%DTC S Y=% D DD^%DT S REPTIME=Y
K ^XTMP(ROUTNAME,$J)
D COMPILE(TARDATE,NONACT)
F GLO="^AUPNMCD","^AUPNMCR","^AUPNRRE" D
.D GENCOMPL(GLO,TARDATE,NONACT)
I '$D(^XTMP(ROUTNAME,$J)) W !,"NO INSURANCE MEMBERS FOUND FOR ",$P($G(^DIC(4,TARFAC,0)),U)," FACILITES" H 3 G EN
D SORTMAX("^XTMP("_ROUTNAME_",$J)")
D PRINTMAX("^XTMP("_ROUTNAME_",$J,""MAXSORT"")")
Q
ASKDEV ;EP
S %ZIS="Q"
D ^%ZIS
Q
HDR ;EP
X ^%ZOSF("UCI") S UCI=$P(Y,",")
W @IOF
D CENTER("PATIENT REGISTRATION")
W !!
D CENTER($P($G(^DIC(4,DUZ(2),0)),U))
W !!
D CENTER("TOP 20 INSURERS REPORT")
W !!,$$CJ^XLFSTR("*** NOTE: IF YOU EDIT A PATIENT AND SEE THEIR NAME IN REVERSE VIDEO ***",IOM)
W !,$$CJ^XLFSTR("*** WITH '(RHI)' BLINKING NEXT TO IT, IT MEANS THEY HAVE RESTRICTED ***",IOM)
W !,$$CJ^XLFSTR("*** HEALTH INFORMATION ***",IOM)
Q
CENTER(X) ;
S CENTER=IOM/2
W ?CENTER-($L(X)/2),X
Q
COMPILE(TARDATE,NONACT,MAXDISP) ;EP - GO THROUGH THE PRVT ELG FILE AND
;FIND ALL PATIENTS WITH ACTIVE POLICIES
N PDFN,INS
S ELIGCNT=0
S PDFN=0
F S PDFN=$O(^AUPNPRVT(PDFN)) Q:'PDFN D
.Q:'$D(^AUPNPAT(PDFN,0)) ;BAD NODE
.I TARFAC'="ALL" Q:'$D(^AUPNPAT(PDFN,41,TARFAC,0)) ;SKIP FACILITIES NOT PICKED AT 'ASKFAC' PROMPT
.S STATDT=$P($G(^AUPNPAT(PDFN,41,TARFAC,0)),U,3) ;INACTIVATED/DELETED FIELD
.I NONACT I TARDATE=STATDT!(TARDATE>STATDT),(STATDT'="") Q ;IF THEY WANT TO DISREGARD NOACTIVE PATIENTS AND THE PATIENT IS CONSIDERED INACTIVE THEN QUIT
.S INS=0
.F S INS=$O(^AUPNPRVT(PDFN,11,INS)) Q:'INS D
..S ELIGDT=$P($G(^AUPNPRVT(PDFN,11,INS,0)),U,6)
..S EXPDT=$P($G(^AUPNPRVT(PDFN,11,INS,0)),U,7)
..S COVTYP=$P($G(^AUPNPRVT(PDFN,11,INS,0)),U,3) S:COVTYP'="" COVTYP=$P($G(^AUTTPIC(COVTYP,0)),U) S:COVTYP="" COVTYP="UNDEF"
..I $$ISACTIVE(ELIGDT,EXPDT,TARDATE) D
...S INSPTR=$P($G(^AUPNPRVT(PDFN,11,INS,0)),U) S:INSPTR="" INSPTR="UNDEF"
...S ELIGCNT=ELIGCNT+1
...S ^XTMP(ROUTNAME,$J,INSPTR,COVTYP)=$G(^XTMP(ROUTNAME,$J,INSPTR,COVTYP))+1
Q
GENCOMPL(GLO,TARDATE,NONACT) ;EP - LETS DO THE OTHER INSURERS. PASS
;GLOBAL ROOT
N PDFN,ELIGDT,EXPDT,ELIGCNT
S PDFN=0,ELIGCNT=0
F S PDFN=$O(@GLO@(PDFN)) Q:PDFN=""!('PDFN) D
.Q:'$D(@GLO@(PDFN,11)) ;NO ELIGIBILITY DATES
.Q:'$D(^AUPNPAT(PDFN,0)) ;NOT EVEN REGISTERED
.I TARFAC'="ALL" Q:'$D(^AUPNPAT(PDFN,41,TARFAC,0)) ;SKIP FACILITIES NOT PICKED AT 'ASKFAC' PROMPT
.S STATDT=$P($G(^AUPNPAT(PDFN,41,DUZ(2),0)),U,3) ;INACTIVATED/DELETED FIELD
.S DTREC=0
.F S DTREC=$O(@GLO@(PDFN,11,DTREC)) Q:'DTREC D
..S ELIGDT=$P($G(@GLO@(PDFN,11,DTREC,0)),U)
..S EXPDT=$P($G(@GLO@(PDFN,11,DTREC,0)),U,2)
..S COVTYP=$P($G(@GLO@(PDFN,11,DTREC,0)),U,3) S:COVTYP="" COVTYP="UNDEF"
..I $$ISACTIVE(ELIGDT,EXPDT,TARDATE) D
...S INSPTR=$P($G(@GLO@(PDFN,0)),U,2) S:INSPTR="" INSPTR="UNDEF"
...S ELIGCNT=ELIGCNT+1
...S ^XTMP(ROUTNAME,$J,INSPTR,COVTYP)=$G(^XTMP(ROUTNAME,$J,INSPTR,COVTYP))+1
Q
ISACTIVE(EFFDT,ENDDT,TARDATE) ;
NEW OPENEND
I EFFDT="",(ENDDT="") Q 0
S ENDDT=ENDDT ;TRUE IF ENDING DATE IS AT COB OF ENDING DATE - ANSWER FROM ADRIAN IS IT IS
; IN FORCE FOR ALL OF TODAY
S OPENEND=ENDDT=""
I OPENEND I TARDATE=EFFDT!(TARDATE>EFFDT) Q 1
I TARDATE=EFFDT!(TARDATE=ENDDT) Q 1
I TARDATE>EFFDT&(TARDATE<ENDDT) Q 1
Q 0
SORTMAX(GLO) ;EP - GO THROUGH TEMP GLOBAL AND RE-SORT BY MAX
N INSPTR,COVTYP
S INSPTR=""
F S INSPTR=$O(^XTMP(ROUTNAME,$J,INSPTR)) Q:INSPTR=""!(INSPTR="ZMAXSORT") D
.S COVTYP=""
.F S COVTYP=$O(^XTMP(ROUTNAME,$J,INSPTR,COVTYP)) Q:COVTYP="" D
..S MAX=$G(^XTMP(ROUTNAME,$J,INSPTR,COVTYP))
..S ^XTMP(ROUTNAME,$J,"ZMAXSORT",MAX,INSPTR,COVTYP)=""
Q
PRINTMAX(GLO) ;EP - PRINT THE MAX COUNTS OUT
D MAINHDR
U IO
N MAX,LINE,ESCAPE
S ESCAPE=0,LINE=0
S MAX=""
F RANK=1:1 S MAX=$O(^XTMP(ROUTNAME,$J,"ZMAXSORT",MAX),-1) Q:MAX=""!(ESCAPE) D
.S INSPTR=""
.F S INSPTR=$O(^XTMP(ROUTNAME,$J,"ZMAXSORT",MAX,INSPTR)) Q:INSPTR=""!(ESCAPE) D
..S COVTYP=""
..F ITEM=1:1 S COVTYP=$O(^XTMP(ROUTNAME,$J,"ZMAXSORT",MAX,INSPTR,COVTYP)) Q:COVTYP=""!(ESCAPE) D
...W:ITEM'=1 !
...S LINE=LINE+1
...S ESCAPE=LINE>MAXDISP
...I ESCAPE,(IOST[("C-")) W ! K DIR S DIR(0)="E" D ^DIR Q
...I ESCAPE,(IOST'[("C-")) Q
...W !?2,$E($P($G(^AUTNINS(INSPTR,0)),U),1,23)
...W ?31,$S(COVTYP="UNDEF":"",1:COVTYP)
...W ?62,MAX
...;NOTE: HEADER IS 10 LINES
...I $Y>(IOSL-10),(IOST[("C-")) W ! K DIR S DIR(0)="E" D ^DIR S ESCAPE=X=U D:'ESCAPE MAINHDR Q
...I $Y>(IOSL-10) D MAINHDR
Q
MAINHDR ;EP
S PAGENO=PAGENO+1
W @IOF
W !,$P($G(^VA(200,DUZ,0)),U)
D CENTER($P($G(^DIC(4,DUZ(2),0)),U))
W ?73,"Page ",PAGENO
W !
D CENTER("TOP '"_MAXDISP_"' INSURER'S REPORT")
W !
D CENTER("as of "_REPTIME)
W !!
I NONACT D CENTER("REPORT CONTAINS ACTIVE PATIENTS ONLY")
W !!
W !?2,"INSURER",?26,"COVERAGE TYPE",?61,"COUNT"
W !,$G(AGLINE("EQ"))
Q
EXIT ;EP - CLEANUP VARS
K CENTER,COVTYP,DIR,DTREC,EFFDT,ELIGCNT,ELIGDT,ENDDT,ESCAPE,EXPDT,GLO,TARFAC,AGLINE,TARDATE,NONACT,PAGENO,ROUTNAME
Q
QUE ;EP
K IO("Q")
S ZTRTN="RUN^AGRPTINS(TARDATE,NONACT)",ZTDESC="REPORT OF TOP "_MAXDISP_" INSURERS"
S ZTSAVE("ROUTNAME")=""
S ZTSAVE("AGLINE")=""
S ZTSAVE("TARFAC")=""
S ZTSAVE("TARDATE")=""
S ZTSAVE("NONACT")=""
S ZTSAVE("MAXDISP")=""
S ZTSAVE("PAGENO")=0
D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED AS TASK # "_ZTSK_" !",!
Q
AGRPTINS ; IHS/SD/TPF - REPORT OF TOP 'N' INSURERS
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
+3 ;RUN A REPORT TO LIST THE TOP INSURERS THAT HAVE OPEN ELIGBILITY
+4 ;AT A SPECIFIC POINT IN TIME.
+5 ;I.E. ASK FOR A SPECIFIC POINT IN TIME
+6 ;GO THROUGH THE PRIVATE ELIGIBILITY,MEDICAID,MEDICARE FILE AND
+7 ;FIND INSURERS THAT ARE ACTIVE. LET USER CHOOSE TO DISREGARD NON
+8 ;ACTIVE PATIENTS. ALLOW USER TO CHOOSE HOW MANY TOP INSURERS TO
+9 ;LIST
+10 ;
EN ;EP
+1 SET ROUTNAME=$PIECE($TEXT(+1)," ")
+2 IF $GET(AGLINE("EQ"))=""
SET $PIECE(AGLINE("EQ"),"=",81)=""
+3 DO HDR
ASKFAC ;EP - ASK FOR A SPECIFIC FACILITY OR ALL
+1 KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT,TARFAC
+2 SET DIR("A")="Check for which Facility: All//"
+3 SET DIR(0)="POA^9999999.06:EMZ"
+4 DO ^DIR
+5 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
DO EXIT
QUIT
+6 IF X=""
SET TARFAC="ALL"
+7 IF '$TEST
SET TARFAC=+Y
+8 KILL DIR
ASKDT ;EP - ASK FOR THE 'POINT IN TIME'
+1 WRITE !!
+2 KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT
+3 SET DIR("A")="Date for the point in Time want eligibility for"
+4 SET DIR(0)="DO"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
GOTO ASKFAC
+7 SET TARDATE=Y
+8 KILL DIR
ASKACTPT ;EP - ASK WHETHER TO DISREGARD NON-ACTIVE PATIENTS
+1 KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET DIR("A")="Want to check if patient is active? "
+3 SET DIR(0)="YOA"
+4 DO ^DIR
+5 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
GOTO ASKDT
+6 ;IF TRUE THEN DO NOT COUNT NON-ACTIVE PATIENTS
SET NONACT=+Y
+7 KILL DIR
ASKENTRY ;EP
+1 KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET DIR("A")="How many entries do you want in the list"
+3 SET DIR("B")=20
+4 SET DIR(0)="NO^5:100"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
GOTO ASKACTPT
+7 SET MAXDISP=+Y
+8 KILL DIR
+9 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET REPTIME=Y
+10 DO ASKDEV
+11 IF POP
GOTO EN
+12 IF $GET(IO("Q"))
DO QUE
QUIT
+13 USE IO
+14 SET PAGENO=0
+15 DO RUN(TARDATE,NONACT)
+16 DO ^%ZISC
+17 GOTO EN
RUN(TARDATE,NONACT) ;EP
+1 ;IF REPTIME IS NULL THEN TASKMAN IS CALLING
+2 IF $GET(REPTIME)=""
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET REPTIME=Y
+3 KILL ^XTMP(ROUTNAME,$JOB)
+4 DO COMPILE(TARDATE,NONACT)
+5 FOR GLO="^AUPNMCD","^AUPNMCR","^AUPNRRE"
Begin DoDot:1
+6 DO GENCOMPL(GLO,TARDATE,NONACT)
End DoDot:1
+7 IF '$DATA(^XTMP(ROUTNAME,$JOB))
WRITE !,"NO INSURANCE MEMBERS FOUND FOR ",$PIECE($GET(^DIC(4,TARFAC,0)),U)," FACILITES"
HANG 3
GOTO EN
+8 DO SORTMAX("^XTMP("_ROUTNAME_",$J)")
+9 DO PRINTMAX("^XTMP("_ROUTNAME_",$J,""MAXSORT"")")
+10 QUIT
ASKDEV ;EP
+1 SET %ZIS="Q"
+2 DO ^%ZIS
+3 QUIT
HDR ;EP
+1 XECUTE ^%ZOSF("UCI")
SET UCI=$PIECE(Y,",")
+2 WRITE @IOF
+3 DO CENTER("PATIENT REGISTRATION")
+4 WRITE !!
+5 DO CENTER($PIECE($GET(^DIC(4,DUZ(2),0)),U))
+6 WRITE !!
+7 DO CENTER("TOP 20 INSURERS REPORT")
+8 WRITE !!,$$CJ^XLFSTR("*** NOTE: IF YOU EDIT A PATIENT AND SEE THEIR NAME IN REVERSE VIDEO ***",IOM)
+9 WRITE !,$$CJ^XLFSTR("*** WITH '(RHI)' BLINKING NEXT TO IT, IT MEANS THEY HAVE RESTRICTED ***",IOM)
+10 WRITE !,$$CJ^XLFSTR("*** HEALTH INFORMATION ***",IOM)
+11 QUIT
CENTER(X) ;
+1 SET CENTER=IOM/2
+2 WRITE ?CENTER-($LENGTH(X)/2),X
+3 QUIT
COMPILE(TARDATE,NONACT,MAXDISP) ;EP - GO THROUGH THE PRVT ELG FILE AND
+1 ;FIND ALL PATIENTS WITH ACTIVE POLICIES
+2 NEW PDFN,INS
+3 SET ELIGCNT=0
+4 SET PDFN=0
+5 FOR
SET PDFN=$ORDER(^AUPNPRVT(PDFN))
IF 'PDFN
QUIT
Begin DoDot:1
+6 ;BAD NODE
IF '$DATA(^AUPNPAT(PDFN,0))
QUIT
+7 ;SKIP FACILITIES NOT PICKED AT 'ASKFAC' PROMPT
IF TARFAC'="ALL"
IF '$DATA(^AUPNPAT(PDFN,41,TARFAC,0))
QUIT
+8 ;INACTIVATED/DELETED FIELD
SET STATDT=$PIECE($GET(^AUPNPAT(PDFN,41,TARFAC,0)),U,3)
+9 ;IF THEY WANT TO DISREGARD NOACTIVE PATIENTS AND THE PATIENT IS CONSIDERED INACTIVE THEN QUIT
IF NONACT
IF TARDATE=STATDT!(TARDATE>STATDT)
IF (STATDT'="")
QUIT
+10 SET INS=0
+11 FOR
SET INS=$ORDER(^AUPNPRVT(PDFN,11,INS))
IF 'INS
QUIT
Begin DoDot:2
+12 SET ELIGDT=$PIECE($GET(^AUPNPRVT(PDFN,11,INS,0)),U,6)
+13 SET EXPDT=$PIECE($GET(^AUPNPRVT(PDFN,11,INS,0)),U,7)
+14 SET COVTYP=$PIECE($GET(^AUPNPRVT(PDFN,11,INS,0)),U,3)
IF COVTYP'=""
SET COVTYP=$PIECE($GET(^AUTTPIC(COVTYP,0)),U)
IF COVTYP=""
SET COVTYP="UNDEF"
+15 IF $$ISACTIVE(ELIGDT,EXPDT,TARDATE)
Begin DoDot:3
+16 SET INSPTR=$PIECE($GET(^AUPNPRVT(PDFN,11,INS,0)),U)
IF INSPTR=""
SET INSPTR="UNDEF"
+17 SET ELIGCNT=ELIGCNT+1
+18 SET ^XTMP(ROUTNAME,$JOB,INSPTR,COVTYP)=$GET(^XTMP(ROUTNAME,$JOB,INSPTR,COVTYP))+1
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
GENCOMPL(GLO,TARDATE,NONACT) ;EP - LETS DO THE OTHER INSURERS. PASS
+1 ;GLOBAL ROOT
+2 NEW PDFN,ELIGDT,EXPDT,ELIGCNT
+3 SET PDFN=0
SET ELIGCNT=0
+4 FOR
SET PDFN=$ORDER(@GLO@(PDFN))
IF PDFN=""!('PDFN)
QUIT
Begin DoDot:1
+5 ;NO ELIGIBILITY DATES
IF '$DATA(@GLO@(PDFN,11))
QUIT
+6 ;NOT EVEN REGISTERED
IF '$DATA(^AUPNPAT(PDFN,0))
QUIT
+7 ;SKIP FACILITIES NOT PICKED AT 'ASKFAC' PROMPT
IF TARFAC'="ALL"
IF '$DATA(^AUPNPAT(PDFN,41,TARFAC,0))
QUIT
+8 ;INACTIVATED/DELETED FIELD
SET STATDT=$PIECE($GET(^AUPNPAT(PDFN,41,DUZ(2),0)),U,3)
+9 SET DTREC=0
+10 FOR
SET DTREC=$ORDER(@GLO@(PDFN,11,DTREC))
IF 'DTREC
QUIT
Begin DoDot:2
+11 SET ELIGDT=$PIECE($GET(@GLO@(PDFN,11,DTREC,0)),U)
+12 SET EXPDT=$PIECE($GET(@GLO@(PDFN,11,DTREC,0)),U,2)
+13 SET COVTYP=$PIECE($GET(@GLO@(PDFN,11,DTREC,0)),U,3)
IF COVTYP=""
SET COVTYP="UNDEF"
+14 IF $$ISACTIVE(ELIGDT,EXPDT,TARDATE)
Begin DoDot:3
+15 SET INSPTR=$PIECE($GET(@GLO@(PDFN,0)),U,2)
IF INSPTR=""
SET INSPTR="UNDEF"
+16 SET ELIGCNT=ELIGCNT+1
+17 SET ^XTMP(ROUTNAME,$JOB,INSPTR,COVTYP)=$GET(^XTMP(ROUTNAME,$JOB,INSPTR,COVTYP))+1
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
ISACTIVE(EFFDT,ENDDT,TARDATE) ;
+1 NEW OPENEND
+2 IF EFFDT=""
IF (ENDDT="")
QUIT 0
+3 ;TRUE IF ENDING DATE IS AT COB OF ENDING DATE - ANSWER FROM ADRIAN IS IT IS
SET ENDDT=ENDDT
+4 ; IN FORCE FOR ALL OF TODAY
+5 SET OPENEND=ENDDT=""
+6 IF OPENEND
IF TARDATE=EFFDT!(TARDATE>EFFDT)
QUIT 1
+7 IF TARDATE=EFFDT!(TARDATE=ENDDT)
QUIT 1
+8 IF TARDATE>EFFDT&(TARDATE<ENDDT)
QUIT 1
+9 QUIT 0
SORTMAX(GLO) ;EP - GO THROUGH TEMP GLOBAL AND RE-SORT BY MAX
+1 NEW INSPTR,COVTYP
+2 SET INSPTR=""
+3 FOR
SET INSPTR=$ORDER(^XTMP(ROUTNAME,$JOB,INSPTR))
IF INSPTR=""!(INSPTR="ZMAXSORT")
QUIT
Begin DoDot:1
+4 SET COVTYP=""
+5 FOR
SET COVTYP=$ORDER(^XTMP(ROUTNAME,$JOB,INSPTR,COVTYP))
IF COVTYP=""
QUIT
Begin DoDot:2
+6 SET MAX=$GET(^XTMP(ROUTNAME,$JOB,INSPTR,COVTYP))
+7 SET ^XTMP(ROUTNAME,$JOB,"ZMAXSORT",MAX,INSPTR,COVTYP)=""
End DoDot:2
End DoDot:1
+8 QUIT
PRINTMAX(GLO) ;EP - PRINT THE MAX COUNTS OUT
+1 DO MAINHDR
+2 USE IO
+3 NEW MAX,LINE,ESCAPE
+4 SET ESCAPE=0
SET LINE=0
+5 SET MAX=""
+6 FOR RANK=1:1
SET MAX=$ORDER(^XTMP(ROUTNAME,$JOB,"ZMAXSORT",MAX),-1)
IF MAX=""!(ESCAPE)
QUIT
Begin DoDot:1
+7 SET INSPTR=""
+8 FOR
SET INSPTR=$ORDER(^XTMP(ROUTNAME,$JOB,"ZMAXSORT",MAX,INSPTR))
IF INSPTR=""!(ESCAPE)
QUIT
Begin DoDot:2
+9 SET COVTYP=""
+10 FOR ITEM=1:1
SET COVTYP=$ORDER(^XTMP(ROUTNAME,$JOB,"ZMAXSORT",MAX,INSPTR,COVTYP))
IF COVTYP=""!(ESCAPE)
QUIT
Begin DoDot:3
+11 IF ITEM'=1
WRITE !
+12 SET LINE=LINE+1
+13 SET ESCAPE=LINE>MAXDISP
+14 IF ESCAPE
IF (IOST[("C-"))
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
QUIT
+15 IF ESCAPE
IF (IOST'[("C-"))
QUIT
+16 WRITE !?2,$EXTRACT($PIECE($GET(^AUTNINS(INSPTR,0)),U),1,23)
+17 WRITE ?31,$SELECT(COVTYP="UNDEF":"",1:COVTYP)
+18 WRITE ?62,MAX
+19 ;NOTE: HEADER IS 10 LINES
+20 IF $Y>(IOSL-10)
IF (IOST[("C-"))
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET ESCAPE=X=U
IF 'ESCAPE
DO MAINHDR
QUIT
+21 IF $Y>(IOSL-10)
DO MAINHDR
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT
MAINHDR ;EP
+1 SET PAGENO=PAGENO+1
+2 WRITE @IOF
+3 WRITE !,$PIECE($GET(^VA(200,DUZ,0)),U)
+4 DO CENTER($PIECE($GET(^DIC(4,DUZ(2),0)),U))
+5 WRITE ?73,"Page ",PAGENO
+6 WRITE !
+7 DO CENTER("TOP '"_MAXDISP_"' INSURER'S REPORT")
+8 WRITE !
+9 DO CENTER("as of "_REPTIME)
+10 WRITE !!
+11 IF NONACT
DO CENTER("REPORT CONTAINS ACTIVE PATIENTS ONLY")
+12 WRITE !!
+13 WRITE !?2,"INSURER",?26,"COVERAGE TYPE",?61,"COUNT"
+14 WRITE !,$GET(AGLINE("EQ"))
+15 QUIT
EXIT ;EP - CLEANUP VARS
+1 KILL CENTER,COVTYP,DIR,DTREC,EFFDT,ELIGCNT,ELIGDT,ENDDT,ESCAPE,EXPDT,GLO,TARFAC,AGLINE,TARDATE,NONACT,PAGENO,ROUTNAME
+2 QUIT
QUE ;EP
+1 KILL IO("Q")
+2 SET ZTRTN="RUN^AGRPTINS(TARDATE,NONACT)"
SET ZTDESC="REPORT OF TOP "_MAXDISP_" INSURERS"
+3 SET ZTSAVE("ROUTNAME")=""
+4 SET ZTSAVE("AGLINE")=""
+5 SET ZTSAVE("TARFAC")=""
+6 SET ZTSAVE("TARDATE")=""
+7 SET ZTSAVE("NONACT")=""
+8 SET ZTSAVE("MAXDISP")=""
+9 SET ZTSAVE("PAGENO")=0
+10 DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !,"REQUEST QUEUED AS TASK # "_ZTSK_" !",!
+11 QUIT
