- 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
