AGBENPRC ;IHS/ASDS/TPF - PRINT BENEFIT PRODUCTIVITY REPORT BY COORD; MAR 19, 2010
;;7.1;PATIENT REGISTRATION;**4,7,8**;AUG 25, 2005
;
START ;
W @IOF
D INIT
ASKDATE ;EP -
K DIR
S DIR(0)="YO"
S DIR("A")="DO YOU WISH TO ENTER A DATE RANGE"
S DIR("B")="YES"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)
I 'Y S AGBEG=$O(^AUPNAPPS("D","")),AGEND=$O(^AUPNAPPS("D",""),-1) G ASKCO
ASKBEG ;EP -
W !!
S %DT("A")="SELECT BEGINNING DATE RANGE: "
S %DT="APE"
D ^%DT
G:X=""!(X[U) ASKDATE
S AGBEG=Y
ASKEND ;
W !!
S %DT("A")="SELECT ENDING DATE RANGE: "
S %DT="APE"
D ^%DT
G:X=""!(X[U)!(Y<0) ASKBEG
S AGEND=Y
I AGBEG>AGEND W !!,*7,"INVALID ENTRY - The END is before the BEGINNING." G ASKBEG
;
ASKCO ;EP -
W !!
K DIR,ASKCOORD
S DIR(0)="YO"
S DIR("A")="DO YOU WISH TO INCLUDE A PARTICULAR BENEFIT COORDINATOR"
S DIR("B")="YES"
D ^DIR
G:$D(DTOUT)!$D(DUOUT) ASKDATE
I 'Y G ASKTYPE
ASKCO1 ;EP -
K DIR,DIC,DIE,DR,DA
S DIC=200
S DIC("A")="SELECT BENEFIT COORDINATOR: "
S:$D(ASKCOORD) DIC("A")="SELECT ANOTHER BENEFIT COORDINATOR: "
S DIC(0)="AEMQ"
D ^DIC
I +Y>0 S ASKCOORD(+Y)="" G ASKCO1
;
;
ASKTYPE ;EP - APPLICATION TYPE
W !!
K DIR,APPTYPE
S DIR(0)="YO"
S DIR("A")="DO YOU WISH TO INCLUDE A PARTICULAR APPLICATION TYPE"
S DIR("B")="YES"
D ^DIR
G:$D(DTOUT)!$D(DUOUT) ASKCO
I 'Y G ASKSTAT
;
ASKTYPE1 ;EP -
K DIR,DIE,DR,DA,DIC
S DIC="^AUPNAPPT("
S DIC("A")="SELECT AN APPLICATION TYPE: "
S:$D(APPTYPE) DIC("A")="SELECT ANOTHER APPLICATION TYPE: "
S DIC(0)="AEMQ"
D ^DIC
G:X="" ASKSTAT
I Y>0 S APPTYPE(+Y)="" G ASKTYPE1
;
ASKSTAT ;EP - OVERALL STATUS
W !!
K DIR,ASKSTAT
S DIR(0)="YO"
S DIR("A")="DO YOU WISH TO INCLUDE A PARTICULAR STATUS? "
S DIR("B")="YES"
D ^DIR
G:$D(DTOUT)!$D(DUOUT) ASKTYPE
I 'Y G CONT
;
ASKSTAT1 ;EP -
S CHOICE=$P(^DD(9000045.11,.04,0),U,3)
K DIR
S DIR("A")="ENTER AN APPLICATION STATUS? "
S:$D(ASKSTAT) DIR("A")="ENTER ANOTHER APPLICATION STATUS? "
S DIR(0)="SO^"_CHOICE
D ^DIR
G:$D(DTOUT)!$D(DUOUT) ASKTYPE
I Y'="" S ASKSTAT(Y)="" G ASKSTAT1
CONT ;EP -
D DEV Q:POP
I $D(ZTSK) W !,"Report queued with task # ",$G(ZTSK) K DIR S DIR(0)="E" D ^DIR Q
U IO
D QUEUED
D HOME^%ZIS
D ^%ZISC
Q
QUEUED ;
D PROCESS
D PRINT
Q
PROCESS ;
N IEN,REC
S AGBEGX=$$FMTE^XLFDT(AGBEG,5)
S AGENDX=$$FMTE^XLFDT(AGEND,5)
K ^XTMP("AGBENPRC",$J)
S AGBEG=AGBEG-.01
F S AGBEG=$O(^AUPNAPPS("D",AGBEG)) Q:AGBEG=""!(AGBEG>AGEND) D
.S IEN=""
.F S IEN=$O(^AUPNAPPS("D",AGBEG,IEN)) Q:IEN="" D
..S REC=""
..F S REC=$O(^AUPNAPPS("D",AGBEG,IEN,REC)) Q:REC="" D
...S AGPAT=$$GET1^DIQ(9000045,IEN_",",.01,"I")
...S AGCHART=$P($G(^AUPNPAT(AGPAT,41,DUZ(2),0)),U,2)
...S:AGCHART="" AGCHART="UNDEF"
...S AGTYPE=$P($G(^AUPNAPPS(IEN,11,REC,0)),U,2)
...S:AGTYPE="" AGTYPE="UNDEF"
...I $D(APPTYPE) Q:'$D(APPTYPE(AGTYPE))
...S:AGTYPE'="UNDEF" AGTYPE=$P($G(^AUPNAPPT(AGTYPE,0)),U)
...S PERSREC=$P($G(^AUPNAPPS(IEN,11,REC,0)),U,3)
...S:PERSREC="" PERSREC="UNDEF"
...I $D(ASKCOORD) Q:'$D(ASKCOORD(PERSREC))
...S:PERSREC'="UNDEF" PERSREC=$P($G(^VA(200,PERSREC,0)),U)
...S OVERSTAT=$P($G(^AUPNAPPS(IEN,11,REC,0)),U,4)
...S:OVERSTAT="" OVERSTAT="UNDEF"
...I $D(ASKSTAT) Q:'$D(ASKSTAT(OVERSTAT))
...S IENS=REC_","_IEN_","
...S OVERSTAT=$$GET1^DIQ(9000045.11,IENS,.04,"E")
...S:OVERSTAT="" OVERSTAT="UNDEF"
...;
...S ^XTMP("AGBENPRC",$J,PERSREC,AGBEG,AGTYPE,OVERSTAT,AGCHART)=""
Q
PRINT ;
;
N AGBEG,AGBEGEX,PERSREC,OLDPERS,AGTYPE,OVERSTAT,AGCHART,ESC,AGCNT ;AG*7.1*8
S PERSREC=$O(^XTMP("AGBENPRC",$J,""))
I PERSREC="" W !!,"NO APPLICATIONS FOUND WITH THE CRITERIA ENTERED" H 3 Q
S PERSREC="",OLDPERS="",AGCNT=0 ;AG*7.1*8
;F S PERSREC=$O(^XTMP("AGBENPRC",$J,PERSREC)) Q:PERSREC="" D
;AG*7.1*7/IHS/SD/AR 02/23/2010
F S PERSREC=$O(^XTMP("AGBENPRC",$J,PERSREC)) Q:PERSREC=""!$G(ESC) D
.I OLDPERS'=PERSREC D
..;I IOST[("C-") W !! K DIR S DIR(0)="E" D ^DIR
..;AG*7.1*7/IHS/SD/AR 02/23/2010
..I IOST[("C-") W !! K DIR S DIR(0)="E" D ^DIR S ESC=X=U
..Q:$G(ESC)
..S AGCNT=AGCNT+1 ;AG*7.1*8
..D HDR,SUBHDR
.Q:$G(ESC)
.S AGBEG=""
.F S AGBEG=$O(^XTMP("AGBENPRC",$J,PERSREC,AGBEG)) Q:AGBEG="" D
..S AGTYPE=""
..F S AGTYPE=$O(^XTMP("AGBENPRC",$J,PERSREC,AGBEG,AGTYPE)) Q:AGTYPE="" D
...S OVERSTAT=""
...F S OVERSTAT=$O(^XTMP("AGBENPRC",$J,PERSREC,AGBEG,AGTYPE,OVERSTAT)) Q:OVERSTAT="" D
....S AGCHART=""
....;F S AGCHART=$O(^XTMP("AGBENPRC",$J,PERSREC,AGBEG,AGTYPE,OVERSTAT,AGCHART)) Q:AGCHART="" D
....;AG*7.1*7/IHS/SD/AR 02/23/2010
....F S AGCHART=$O(^XTMP("AGBENPRC",$J,PERSREC,AGBEG,AGTYPE,OVERSTAT,AGCHART)) Q:AGCHART=""!$G(ESC) D
.....;I ($Y=(IOSL-4)) W !! K DIR S DIR(0)="E" D:IOST[("C-") ^DIR D HDR,SUBHDR
.....;AG*7.1*7/IHS/SD/AR 02/23/2010
.....I ($Y=(IOSL-4)) W !! K DIR S DIR(0)="E" D:IOST[("C-") ^DIR S ESC=X=U Q:$G(ESC) D HDR,SUBHDR
.....S Y=AGBEG X ^DD("DD") S AGBEGEX=Y
.....W !,AGBEGEX
.....W ?15,AGCHART
.....W ?30,AGTYPE
.....W ?60,OVERSTAT
.....S AGCNT(PERSREC,AGTYPE,OVERSTAT)=$G(AGCNT(PERSREC,AGTYPE,OVERSTAT))+1 ;AG*7.1*8
.....S AGCNT(0,AGTYPE,OVERSTAT)=$G(AGCNT(0,AGTYPE,OVERSTAT))+1 ;AG*7.1*8
.....;I IOST[("C-"),'$O(^XTMP("AGBENPRC",$J,PERSREC)) D HDR,SUBHDR
.D TOT(PERSREC) ;AG*7.1*8
I $G(AGCNT)>1 D ;AG*7.1*8
.I IOST[("C-") W !! K DIR S DIR(0)="E" D ^DIR S ESC=X=U
.Q:$G(ESC)
.D TOT(0) ;AG*7.1*8
I $G(ESC) K ^XTMP("AGBENPRC",$J) Q
D ^%ZISC
I '$D(ZTQUEUED) I $Y>IOSL-4,(IOST[("C-")) W !! K DIR S DIR(0)="E" D ^DIR
K ^XTMP("AGBENPRC",$J)
Q
INIT ;
S AGUSER=$$GET1^DIQ(200,DUZ_",",.01,"E")
S AGLOC=$$GET1^DIQ(9999999.06,DUZ(2)_",",.01,"E")
S AGRPTNAM="BENEFIT COORDINATOR PRODUCTIVITY REPORT BY COORDINATOR"
X ^%ZOSF("UCI") S AGUCI=Y
D NOW^%DTC
S Y=% X ^DD("DD")
S AGRPTDT=Y
S AGPAGE=0
S $P(AGDASH,"-",81)=""
S $P(AGEQUAL,"=",81)=""
Q
HDR ;
S AGPAGE=AGPAGE+1
W @IOF
W !,AGUSER,?70,"Page ",AGPAGE
W !,$$C^XBFUNC(AGLOC)
W !,$$C^XBFUNC(AGRPTNAM)
W !,$$C^XBFUNC("UCI: "_AGUCI)
W !,$$C^XBFUNC("Report Date: "_AGRPTDT)
S STR="Date range From "_AGBEGX_" to "_AGENDX
W !,$$C^XBFUNC(STR)
Q
SUBHDR ;
W !!
W AGEQUAL
W "REPORT FOR DATES OBTAINED FROM "
W AGBEGX
W " TO ",AGENDX
W !,"FOR "
I '$D(APPTYPE) W !,"ALL APPLICATION TYPES"
E D
.W "APPLICATION TYPES OF "
.S APPTYPE=""
.F S APPTYPE=$O(APPTYPE(APPTYPE)) Q:APPTYPE="" D
..W $$GET1^DIQ(9000048,APPTYPE_",",.01,"E")
..I $O(APPTYPE(APPTYPE)) W ","
W !,"provided by ",PERSREC
W !,AGEQUAL
W !,"DATE",?15,"CHART",?30,"APPLICATION TYPE",?60,"STATUS"
W !,"OBTAINED"
W !,AGDASH
Q
DEV ;
K %ZIS,ZTSK
S %ZIS="OPQ"
D ^%ZIS
Q:POP
Q:'$D(IO("Q"))
S ZTRTN="QUEUED^AGBENPRC",ZTDESC=AGRPTNAM
S ZTSAVE("AG*")=""
S ZTSAVE("ASKSTAT")=""
S ZTSAVE("APPTYPE")=""
S ZTSAVE("ASKCOORD")=""
D ^%ZTLOAD
Q
TOT(REC) ; ;AG*7.1*8
I REC=0 D
. D HDR
. W !!,?34,"Report Totals"
W !!!,"APPLICATION",?30,"STATUS",?48,"TOTAL COUNT"
W !,"TYPE"
W !,AGEQUAL
N AGTYPE,AGSTAT
S (AGTYPE,AGSTAT)=""
F S AGTYPE=$O(AGCNT(REC,AGTYPE)) Q:AGTYPE="" D
. F S AGSTAT=$O(AGCNT(REC,AGTYPE,AGSTAT)) Q:AGSTAT="" D
.. W !,AGTYPE,?30,AGSTAT,?50,$G(AGCNT(REC,AGTYPE,AGSTAT))
Q
AGBENPRC ;IHS/ASDS/TPF - PRINT BENEFIT PRODUCTIVITY REPORT BY COORD; MAR 19, 2010
+1 ;;7.1;PATIENT REGISTRATION;**4,7,8**;AUG 25, 2005
+2 ;
START ;
+1 WRITE @IOF
+2 DO INIT
ASKDATE ;EP -
+1 KILL DIR
+2 SET DIR(0)="YO"
+3 SET DIR("A")="DO YOU WISH TO ENTER A DATE RANGE"
+4 SET DIR("B")="YES"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+7 IF 'Y
SET AGBEG=$ORDER(^AUPNAPPS("D",""))
SET AGEND=$ORDER(^AUPNAPPS("D",""),-1)
GOTO ASKCO
ASKBEG ;EP -
+1 WRITE !!
+2 SET %DT("A")="SELECT BEGINNING DATE RANGE: "
+3 SET %DT="APE"
+4 DO ^%DT
+5 IF X=""!(X[U)
GOTO ASKDATE
+6 SET AGBEG=Y
ASKEND ;
+1 WRITE !!
+2 SET %DT("A")="SELECT ENDING DATE RANGE: "
+3 SET %DT="APE"
+4 DO ^%DT
+5 IF X=""!(X[U)!(Y<0)
GOTO ASKBEG
+6 SET AGEND=Y
+7 IF AGBEG>AGEND
WRITE !!,*7,"INVALID ENTRY - The END is before the BEGINNING."
GOTO ASKBEG
+8 ;
ASKCO ;EP -
+1 WRITE !!
+2 KILL DIR,ASKCOORD
+3 SET DIR(0)="YO"
+4 SET DIR("A")="DO YOU WISH TO INCLUDE A PARTICULAR BENEFIT COORDINATOR"
+5 SET DIR("B")="YES"
+6 DO ^DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO ASKDATE
+8 IF 'Y
GOTO ASKTYPE
ASKCO1 ;EP -
+1 KILL DIR,DIC,DIE,DR,DA
+2 SET DIC=200
+3 SET DIC("A")="SELECT BENEFIT COORDINATOR: "
+4 IF $DATA(ASKCOORD)
SET DIC("A")="SELECT ANOTHER BENEFIT COORDINATOR: "
+5 SET DIC(0)="AEMQ"
+6 DO ^DIC
+7 IF +Y>0
SET ASKCOORD(+Y)=""
GOTO ASKCO1
+8 ;
+9 ;
ASKTYPE ;EP - APPLICATION TYPE
+1 WRITE !!
+2 KILL DIR,APPTYPE
+3 SET DIR(0)="YO"
+4 SET DIR("A")="DO YOU WISH TO INCLUDE A PARTICULAR APPLICATION TYPE"
+5 SET DIR("B")="YES"
+6 DO ^DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO ASKCO
+8 IF 'Y
GOTO ASKSTAT
+9 ;
ASKTYPE1 ;EP -
+1 KILL DIR,DIE,DR,DA,DIC
+2 SET DIC="^AUPNAPPT("
+3 SET DIC("A")="SELECT AN APPLICATION TYPE: "
+4 IF $DATA(APPTYPE)
SET DIC("A")="SELECT ANOTHER APPLICATION TYPE: "
+5 SET DIC(0)="AEMQ"
+6 DO ^DIC
+7 IF X=""
GOTO ASKSTAT
+8 IF Y>0
SET APPTYPE(+Y)=""
GOTO ASKTYPE1
+9 ;
ASKSTAT ;EP - OVERALL STATUS
+1 WRITE !!
+2 KILL DIR,ASKSTAT
+3 SET DIR(0)="YO"
+4 SET DIR("A")="DO YOU WISH TO INCLUDE A PARTICULAR STATUS? "
+5 SET DIR("B")="YES"
+6 DO ^DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO ASKTYPE
+8 IF 'Y
GOTO CONT
+9 ;
ASKSTAT1 ;EP -
+1 SET CHOICE=$PIECE(^DD(9000045.11,.04,0),U,3)
+2 KILL DIR
+3 SET DIR("A")="ENTER AN APPLICATION STATUS? "
+4 IF $DATA(ASKSTAT)
SET DIR("A")="ENTER ANOTHER APPLICATION STATUS? "
+5 SET DIR(0)="SO^"_CHOICE
+6 DO ^DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO ASKTYPE
+8 IF Y'=""
SET ASKSTAT(Y)=""
GOTO ASKSTAT1
CONT ;EP -
+1 DO DEV
IF POP
QUIT
+2 IF $DATA(ZTSK)
WRITE !,"Report queued with task # ",$GET(ZTSK)
KILL DIR
SET DIR(0)="E"
DO ^DIR
QUIT
+3 USE IO
+4 DO QUEUED
+5 DO HOME^%ZIS
+6 DO ^%ZISC
+7 QUIT
QUEUED ;
+1 DO PROCESS
+2 DO PRINT
+3 QUIT
PROCESS ;
+1 NEW IEN,REC
+2 SET AGBEGX=$$FMTE^XLFDT(AGBEG,5)
+3 SET AGENDX=$$FMTE^XLFDT(AGEND,5)
+4 KILL ^XTMP("AGBENPRC",$JOB)
+5 SET AGBEG=AGBEG-.01
+6 FOR
SET AGBEG=$ORDER(^AUPNAPPS("D",AGBEG))
IF AGBEG=""!(AGBEG>AGEND)
QUIT
Begin DoDot:1
+7 SET IEN=""
+8 FOR
SET IEN=$ORDER(^AUPNAPPS("D",AGBEG,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+9 SET REC=""
+10 FOR
SET REC=$ORDER(^AUPNAPPS("D",AGBEG,IEN,REC))
IF REC=""
QUIT
Begin DoDot:3
+11 SET AGPAT=$$GET1^DIQ(9000045,IEN_",",.01,"I")
+12 SET AGCHART=$PIECE($GET(^AUPNPAT(AGPAT,41,DUZ(2),0)),U,2)
+13 IF AGCHART=""
SET AGCHART="UNDEF"
+14 SET AGTYPE=$PIECE($GET(^AUPNAPPS(IEN,11,REC,0)),U,2)
+15 IF AGTYPE=""
SET AGTYPE="UNDEF"
+16 IF $DATA(APPTYPE)
IF '$DATA(APPTYPE(AGTYPE))
QUIT
+17 IF AGTYPE'="UNDEF"
SET AGTYPE=$PIECE($GET(^AUPNAPPT(AGTYPE,0)),U)
+18 SET PERSREC=$PIECE($GET(^AUPNAPPS(IEN,11,REC,0)),U,3)
+19 IF PERSREC=""
SET PERSREC="UNDEF"
+20 IF $DATA(ASKCOORD)
IF '$DATA(ASKCOORD(PERSREC))
QUIT
+21 IF PERSREC'="UNDEF"
SET PERSREC=$PIECE($GET(^VA(200,PERSREC,0)),U)
+22 SET OVERSTAT=$PIECE($GET(^AUPNAPPS(IEN,11,REC,0)),U,4)
+23 IF OVERSTAT=""
SET OVERSTAT="UNDEF"
+24 IF $DATA(ASKSTAT)
IF '$DATA(ASKSTAT(OVERSTAT))
QUIT
+25 SET IENS=REC_","_IEN_","
+26 SET OVERSTAT=$$GET1^DIQ(9000045.11,IENS,.04,"E")
+27 IF OVERSTAT=""
SET OVERSTAT="UNDEF"
+28 ;
+29 SET ^XTMP("AGBENPRC",$JOB,PERSREC,AGBEG,AGTYPE,OVERSTAT,AGCHART)=""
End DoDot:3
End DoDot:2
End DoDot:1
+30 QUIT
PRINT ;
+1 ;
+2 ;AG*7.1*8
NEW AGBEG,AGBEGEX,PERSREC,OLDPERS,AGTYPE,OVERSTAT,AGCHART,ESC,AGCNT
+3 SET PERSREC=$ORDER(^XTMP("AGBENPRC",$JOB,""))
+4 IF PERSREC=""
WRITE !!,"NO APPLICATIONS FOUND WITH THE CRITERIA ENTERED"
HANG 3
QUIT
+5 ;AG*7.1*8
SET PERSREC=""
SET OLDPERS=""
SET AGCNT=0
+6 ;F S PERSREC=$O(^XTMP("AGBENPRC",$J,PERSREC)) Q:PERSREC="" D
+7 ;AG*7.1*7/IHS/SD/AR 02/23/2010
+8 FOR
SET PERSREC=$ORDER(^XTMP("AGBENPRC",$JOB,PERSREC))
IF PERSREC=""!$GET(ESC)
QUIT
Begin DoDot:1
+9 IF OLDPERS'=PERSREC
Begin DoDot:2
+10 ;I IOST[("C-") W !! K DIR S DIR(0)="E" D ^DIR
+11 ;AG*7.1*7/IHS/SD/AR 02/23/2010
+12 IF IOST[("C-")
WRITE !!
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET ESC=X=U
+13 IF $GET(ESC)
QUIT
+14 ;AG*7.1*8
SET AGCNT=AGCNT+1
+15 DO HDR
DO SUBHDR
End DoDot:2
+16 IF $GET(ESC)
QUIT
+17 SET AGBEG=""
+18 FOR
SET AGBEG=$ORDER(^XTMP("AGBENPRC",$JOB,PERSREC,AGBEG))
IF AGBEG=""
QUIT
Begin DoDot:2
+19 SET AGTYPE=""
+20 FOR
SET AGTYPE=$ORDER(^XTMP("AGBENPRC",$JOB,PERSREC,AGBEG,AGTYPE))
IF AGTYPE=""
QUIT
Begin DoDot:3
+21 SET OVERSTAT=""
+22 FOR
SET OVERSTAT=$ORDER(^XTMP("AGBENPRC",$JOB,PERSREC,AGBEG,AGTYPE,OVERSTAT))
IF OVERSTAT=""
QUIT
Begin DoDot:4
+23 SET AGCHART=""
+24 ;F S AGCHART=$O(^XTMP("AGBENPRC",$J,PERSREC,AGBEG,AGTYPE,OVERSTAT,AGCHART)) Q:AGCHART="" D
+25 ;AG*7.1*7/IHS/SD/AR 02/23/2010
+26 FOR
SET AGCHART=$ORDER(^XTMP("AGBENPRC",$JOB,PERSREC,AGBEG,AGTYPE,OVERSTAT,AGCHART))
IF AGCHART=""!$GET(ESC)
QUIT
Begin DoDot:5
+27 ;I ($Y=(IOSL-4)) W !! K DIR S DIR(0)="E" D:IOST[("C-") ^DIR D HDR,SUBHDR
+28 ;AG*7.1*7/IHS/SD/AR 02/23/2010
+29 IF ($Y=(IOSL-4))
WRITE !!
KILL DIR
SET DIR(0)="E"
IF IOST[("C-")
DO ^DIR
SET ESC=X=U
IF $GET(ESC)
QUIT
DO HDR
DO SUBHDR
+30 SET Y=AGBEG
XECUTE ^DD("DD")
SET AGBEGEX=Y
+31 WRITE !,AGBEGEX
+32 WRITE ?15,AGCHART
+33 WRITE ?30,AGTYPE
+34 WRITE ?60,OVERSTAT
+35 ;AG*7.1*8
SET AGCNT(PERSREC,AGTYPE,OVERSTAT)=$GET(AGCNT(PERSREC,AGTYPE,OVERSTAT))+1
+36 ;AG*7.1*8
SET AGCNT(0,AGTYPE,OVERSTAT)=$GET(AGCNT(0,AGTYPE,OVERSTAT))+1
+37 ;I IOST[("C-"),'$O(^XTMP("AGBENPRC",$J,PERSREC)) D HDR,SUBHDR
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+38 ;AG*7.1*8
DO TOT(PERSREC)
End DoDot:1
+39 ;AG*7.1*8
IF $GET(AGCNT)>1
Begin DoDot:1
+40 IF IOST[("C-")
WRITE !!
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET ESC=X=U
+41 IF $GET(ESC)
QUIT
+42 ;AG*7.1*8
DO TOT(0)
End DoDot:1
+43 IF $GET(ESC)
KILL ^XTMP("AGBENPRC",$JOB)
QUIT
+44 DO ^%ZISC
+45 IF '$DATA(ZTQUEUED)
IF $Y>IOSL-4
IF (IOST[("C-"))
WRITE !!
KILL DIR
SET DIR(0)="E"
DO ^DIR
+46 KILL ^XTMP("AGBENPRC",$JOB)
+47 QUIT
INIT ;
+1 SET AGUSER=$$GET1^DIQ(200,DUZ_",",.01,"E")
+2 SET AGLOC=$$GET1^DIQ(9999999.06,DUZ(2)_",",.01,"E")
+3 SET AGRPTNAM="BENEFIT COORDINATOR PRODUCTIVITY REPORT BY COORDINATOR"
+4 XECUTE ^%ZOSF("UCI")
SET AGUCI=Y
+5 DO NOW^%DTC
+6 SET Y=%
XECUTE ^DD("DD")
+7 SET AGRPTDT=Y
+8 SET AGPAGE=0
+9 SET $PIECE(AGDASH,"-",81)=""
+10 SET $PIECE(AGEQUAL,"=",81)=""
+11 QUIT
HDR ;
+1 SET AGPAGE=AGPAGE+1
+2 WRITE @IOF
+3 WRITE !,AGUSER,?70,"Page ",AGPAGE
+4 WRITE !,$$C^XBFUNC(AGLOC)
+5 WRITE !,$$C^XBFUNC(AGRPTNAM)
+6 WRITE !,$$C^XBFUNC("UCI: "_AGUCI)
+7 WRITE !,$$C^XBFUNC("Report Date: "_AGRPTDT)
+8 SET STR="Date range From "_AGBEGX_" to "_AGENDX
+9 WRITE !,$$C^XBFUNC(STR)
+10 QUIT
SUBHDR ;
+1 WRITE !!
+2 WRITE AGEQUAL
+3 WRITE "REPORT FOR DATES OBTAINED FROM "
+4 WRITE AGBEGX
+5 WRITE " TO ",AGENDX
+6 WRITE !,"FOR "
+7 IF '$DATA(APPTYPE)
WRITE !,"ALL APPLICATION TYPES"
+8 IF '$TEST
Begin DoDot:1
+9 WRITE "APPLICATION TYPES OF "
+10 SET APPTYPE=""
+11 FOR
SET APPTYPE=$ORDER(APPTYPE(APPTYPE))
IF APPTYPE=""
QUIT
Begin DoDot:2
+12 WRITE $$GET1^DIQ(9000048,APPTYPE_",",.01,"E")
+13 IF $ORDER(APPTYPE(APPTYPE))
WRITE ","
End DoDot:2
End DoDot:1
+14 WRITE !,"provided by ",PERSREC
+15 WRITE !,AGEQUAL
+16 WRITE !,"DATE",?15,"CHART",?30,"APPLICATION TYPE",?60,"STATUS"
+17 WRITE !,"OBTAINED"
+18 WRITE !,AGDASH
+19 QUIT
DEV ;
+1 KILL %ZIS,ZTSK
+2 SET %ZIS="OPQ"
+3 DO ^%ZIS
+4 IF POP
QUIT
+5 IF '$DATA(IO("Q"))
QUIT
+6 SET ZTRTN="QUEUED^AGBENPRC"
SET ZTDESC=AGRPTNAM
+7 SET ZTSAVE("AG*")=""
+8 SET ZTSAVE("ASKSTAT")=""
+9 SET ZTSAVE("APPTYPE")=""
+10 SET ZTSAVE("ASKCOORD")=""
+11 DO ^%ZTLOAD
+12 QUIT
TOT(REC) ; ;AG*7.1*8
+1 IF REC=0
Begin DoDot:1
+2 DO HDR
+3 WRITE !!,?34,"Report Totals"
End DoDot:1
+4 WRITE !!!,"APPLICATION",?30,"STATUS",?48,"TOTAL COUNT"
+5 WRITE !,"TYPE"
+6 WRITE !,AGEQUAL
+7 NEW AGTYPE,AGSTAT
+8 SET (AGTYPE,AGSTAT)=""
+9 FOR
SET AGTYPE=$ORDER(AGCNT(REC,AGTYPE))
IF AGTYPE=""
QUIT
Begin DoDot:1
+10 FOR
SET AGSTAT=$ORDER(AGCNT(REC,AGTYPE,AGSTAT))
IF AGSTAT=""
QUIT
Begin DoDot:2
+11 WRITE !,AGTYPE,?30,AGSTAT,?50,$GET(AGCNT(REC,AGTYPE,AGSTAT))
End DoDot:2
End DoDot:1
+12 QUIT
