AGBENPRD ;IHS/ASDS/TPF - PRINT BENEFIT PRODUCTIVITY REPORT; MAR 19, 2010
;;7.1;PATIENT REGISTRATION;**2,4,7,11**;AUG 25, 2005;Build 1
;IHS/OIT/NKD AG*7.1*11 ADDITIONAL OVERALL STATUS ENTRIES
;
START ;
D INIT
ASKBEG ;
W !
S %DT("A")="Enter the BEGINNING DATE for this report: "
S %DT="APE"
D ^%DT
Q:X=""!(X[U)
S AGBEG=Y
ASKEND ;
W !
S %DT("A")="Enter the ENDING DATE for this report: "
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
S AGBEGX=$$FMTE^XLFDT(AGBEG,5)
S AGENDX=$$FMTE^XLFDT(AGEND,5)
;
ASKTYPE ;
K DIR
S DIR(0)="SO^1:RECEIVER;2:APPTYPE"
S DIR("L",1)="Which Type of report do you wish?"
S DIR("L",2)="1... PERSON RECEIVING APPLICATION"
S DIR("L")="2... APPLICATION TYPE"
D ^DIR
G:'Y!($D(DTOUT))!($D(DIROUT))!($D(DUOUT)) ASKEND
S AGRPTTYP=Y(0)
;
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
K ^XTMP("AGBENPRD",$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 AGTYPE=$P($G(^AUPNAPPS(IEN,11,REC,0)),U,2)
...I AGTYPE="" S AGTYPE="UNPOPULATED"
...E S AGTYPE=$P($G(^AUPNAPPT(AGTYPE,0)),U)
...S PERSREC=$P($G(^AUPNAPPS(IEN,11,REC,0)),U,3)
...I PERSREC="" S PERSREC="UNPOPULATED"
...E S PERSREC=$P($G(^VA(200,PERSREC,0)),U)
...S OVERSTAT=$P($G(^AUPNAPPS(IEN,11,REC,0)),U,4)
...S IENS=REC_","_IEN_","
...Q:OVERSTAT=""
...I OVERSTAT="" S OVERSTAT="UNPOPULATED"
...E S OVERSTAT=$$GET1^DIQ(9000045.11,IENS,.04,"I","AGDATA","AGERR")
...;IHS/OIT/NKD AG*7.1*11 CHANGED SETTING OF TMP GLOBAL TO INCLUDE OFFSET AND ADDED 2 NEW ENTRIES
...;S OVERSTAT=$S(OVERSTAT="A":1_U_OVERSTAT,OVERSTAT="D":2_U_OVERSTAT,OVERSTAT="R":3_U_OVERSTAT,OVERSTAT="RE":4_U_OVERSTAT,OVERSTAT="F":5_U_OVERSTAT,OVERSTAT="E":6_U_OVERSTAT,OVERSTAT="P":7_U_OVERSTAT,1:"UNDEFINED")
...S OVERSTAT=$S(OVERSTAT="A":17_U_OVERSTAT,OVERSTAT="D":25_U_OVERSTAT,OVERSTAT="R":32_U_OVERSTAT,OVERSTAT="RE":39_U_OVERSTAT,OVERSTAT="F":47_U_OVERSTAT,OVERSTAT="E":54_U_OVERSTAT,OVERSTAT="P":60_U_OVERSTAT,1:OVERSTAT)
...S:OVERSTAT'[U OVERSTAT=$S(OVERSTAT="O":68_U_OVERSTAT,OVERSTAT="S":75_U_OVERSTAT,1:"UNDEFINED")
...S SUB3=$S(AGRPTTYP="APPTYPE":AGTYPE,1:PERSREC)
...S:SUB3="" SUB3="UNPOPULATED"
...S ^XTMP("AGBENPRD",$J,SUB3,OVERSTAT)=$G(^XTMP("AGBENPRD",$J,SUB3,OVERSTAT))+1
...S ^XTMP("AGBENPRD",$J,"~",OVERSTAT)=$G(^XTMP("AGBENPRD",$J,"~",OVERSTAT))+1
Q
PRINT ;
D HDR
D SUBHDR
S APPTYPE=""
N ESC
;F S APPTYPE=$O(^XTMP("AGBENPRD",$J,APPTYPE)) Q:APPTYPE=""!(APPTYPE="~") D
;AG*7.1*7/IHS/SD/AR 02/23/2010
F S APPTYPE=$O(^XTMP("AGBENPRD",$J,APPTYPE)) Q:APPTYPE=""!(APPTYPE="~")!$G(ESC) D
.W !,$E(APPTYPE,1,15)
.S OVERSTAT=""
.F S OVERSTAT=$O(^XTMP("AGBENPRD",$J,APPTYPE,OVERSTAT)) Q:OVERSTAT="" D
..S STATUS=$P(OVERSTAT,U,2)
..;IHS/OIT/NKD AG*7.1*11 CHANGED $S FOR OFFSET TO USE 1ST PIECE IN TMP GLOBAL
..;S OFFSET=$S(STATUS="A":18,STATUS="D":28,STATUS="R":37,STATUS="RE":47,STATUS="F":58,STATUS="E":66,STATUS="P":75,1:0)
..S OFFSET=+$P(OVERSTAT,U,1)
..;I '$D(ZTQUEUED) I ($Y>(IOSL-4)!($Y=(IOSL-4))),(IOST[("C-")) W !! K DIR S DIR(0)="E" D ^DIR D HDR,SUBHDR Q
..;AG*7.1*7/IHS/SD/AR 02/23/2010
..I '$D(ZTQUEUED) I ($Y>(IOSL-4)!($Y=(IOSL-4))),(IOST[("C-")) W !! K DIR S DIR(0)="E" D ^DIR S ESC=X=U D HDR,SUBHDR Q
..I ($Y>(IOSL-4)!($Y=(IOSL-4))),(IOST'[("C-")) D HDR,SUBHDR
..W ?OFFSET,$G(^XTMP("AGBENPRD",$J,APPTYPE,OVERSTAT))
I $G(ESC) K ^XTMP("AGBENPRD",$J) Q
W !!,AGDASH
W !,"TOTALS"
S OVERSTAT=""
F S OVERSTAT=$O(^XTMP("AGBENPRD",$J,"~",OVERSTAT)) Q:OVERSTAT="" D
.Q:OVERSTAT=0
.Q:STATUS="UNDEFINED"
.S STATUS=$P(OVERSTAT,U,2)
.;IHS/OIT/NKD AG*7.1*11 CHANGED $S FOR OFFSET TO USE 1ST PIECE IN TMP GLOBAL
.;S OFFSET=$S(STATUS="A":18,STATUS="D":28,STATUS="R":37,STATUS="RE":47,STATUS="F":58,STATUS="E":66,STATUS="P":75,1:0)
.S OFFSET=+$P(OVERSTAT,U,1)
.W ?OFFSET,$G(^XTMP("AGBENPRD",$J,"~",OVERSTAT))
D ^%ZISC
I '$D(ZTQUEUED) I $Y>IOSL-4,(IOST[("C-")) W !! K DIR S DIR(0)="E" D ^DIR
K ^XTMP("AGBENPRD",$J)
Q
INIT ;
S AGUSER=$P($G(^VA(200,DUZ,0)),U)
;S AGLOC=$P($G(^AUTTLOC(DUZ(2),0)),U,2)
S AGLOC=$P($G(^AUTTLOC(DUZ(2),0)),U) ;AG*7.1*4 DIDN'T WANT SHORT NAME
S AGRPTNAM="BENEFIT COORDINATOR PRODUCTIVITY REPORT"
X ^%ZOSF("UCI") S AGUCI=Y
D NOW^%DTC
S Y=% X ^DD("DD")
S AGRPTDT=Y
S AGPAGE=0
S $P(AGDASH,"-",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("Date range From "_AGBEGX) W " to ",AGENDX
W !,$$C^XBFUNC(STR)
Q
SUBHDR ;
W !!
W $S(AGRPTTYP="RECEIVER":"PERSON",1:"APPLICATION")
;IHS/OIT/NKD AG*7.1*11 ABBREVIATED COLUMN HEADERS TO FIT ADDITIONAL ENTRIES
;W ?36,"RE-",?53,"FOLLOWUP",?63,"ENTERED"
W !
W $S(AGRPTTYP="RECEIVER":"RECEIVING",1:"TYPE")
;IHS/OIT/NKD AG*7.1*11 ABBREVIATED COLUMN HEADERS TO FIT ADDITIONAL ENTRIES
;W ?14,"APPROVED",?24,"DENIED",?33,"SUBMITTED",?43,"REFUSED",?54,"NEEDED",?62,"IN ERROR",?72,"PENDING"
W ?14,"APPROVED",?23,"DENIED",?30,"RESUB",?36,"REFUSED",?44,"FOLLOWUP",?53,"ERR",?57,"PENDING",?65,"OVERINC",?73,"SCREEN"
W !,AGDASH
W !
Q
DEV ;
K %ZIS,ZTSK
S %ZIS="OPQ"
D ^%ZIS
Q:POP
Q:'$D(IO("Q"))
S ZTRTN="QUEUED^AGBENPRD",ZTDESC=AGRPTNAM
S ZTSAVE("AG*")=""
D ^%ZTLOAD
Q
AGBENPRD ;IHS/ASDS/TPF - PRINT BENEFIT PRODUCTIVITY REPORT; MAR 19, 2010
+1 ;;7.1;PATIENT REGISTRATION;**2,4,7,11**;AUG 25, 2005;Build 1
+2 ;IHS/OIT/NKD AG*7.1*11 ADDITIONAL OVERALL STATUS ENTRIES
+3 ;
START ;
+1 DO INIT
ASKBEG ;
+1 WRITE !
+2 SET %DT("A")="Enter the BEGINNING DATE for this report: "
+3 SET %DT="APE"
+4 DO ^%DT
+5 IF X=""!(X[U)
QUIT
+6 SET AGBEG=Y
ASKEND ;
+1 WRITE !
+2 SET %DT("A")="Enter the ENDING DATE for this report: "
+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 SET AGBEGX=$$FMTE^XLFDT(AGBEG,5)
+9 SET AGENDX=$$FMTE^XLFDT(AGEND,5)
+10 ;
ASKTYPE ;
+1 KILL DIR
+2 SET DIR(0)="SO^1:RECEIVER;2:APPTYPE"
+3 SET DIR("L",1)="Which Type of report do you wish?"
+4 SET DIR("L",2)="1... PERSON RECEIVING APPLICATION"
+5 SET DIR("L")="2... APPLICATION TYPE"
+6 DO ^DIR
+7 IF 'Y!($DATA(DTOUT))!($DATA(DIROUT))!($DATA(DUOUT))
GOTO ASKEND
+8 SET AGRPTTYP=Y(0)
+9 ;
+10 DO DEV
IF POP
QUIT
+11 IF $DATA(ZTSK)
WRITE !,"Report queued with task # ",$GET(ZTSK)
KILL DIR
SET DIR(0)="E"
DO ^DIR
QUIT
+12 USE IO
+13 DO QUEUED
+14 DO HOME^%ZIS
+15 DO ^%ZISC
+16 QUIT
QUEUED ;
+1 DO PROCESS
+2 DO PRINT
+3 QUIT
PROCESS ;
+1 NEW IEN,REC
+2 KILL ^XTMP("AGBENPRD",$JOB)
+3 SET AGBEG=AGBEG-.01
+4 FOR
SET AGBEG=$ORDER(^AUPNAPPS("D",AGBEG))
IF AGBEG=""!(AGBEG>AGEND)
QUIT
Begin DoDot:1
+5 SET IEN=""
+6 FOR
SET IEN=$ORDER(^AUPNAPPS("D",AGBEG,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+7 SET REC=""
+8 FOR
SET REC=$ORDER(^AUPNAPPS("D",AGBEG,IEN,REC))
IF REC=""
QUIT
Begin DoDot:3
+9 SET AGTYPE=$PIECE($GET(^AUPNAPPS(IEN,11,REC,0)),U,2)
+10 IF AGTYPE=""
SET AGTYPE="UNPOPULATED"
+11 IF '$TEST
SET AGTYPE=$PIECE($GET(^AUPNAPPT(AGTYPE,0)),U)
+12 SET PERSREC=$PIECE($GET(^AUPNAPPS(IEN,11,REC,0)),U,3)
+13 IF PERSREC=""
SET PERSREC="UNPOPULATED"
+14 IF '$TEST
SET PERSREC=$PIECE($GET(^VA(200,PERSREC,0)),U)
+15 SET OVERSTAT=$PIECE($GET(^AUPNAPPS(IEN,11,REC,0)),U,4)
+16 SET IENS=REC_","_IEN_","
+17 IF OVERSTAT=""
QUIT
+18 IF OVERSTAT=""
SET OVERSTAT="UNPOPULATED"
+19 IF '$TEST
SET OVERSTAT=$$GET1^DIQ(9000045.11,IENS,.04,"I","AGDATA","AGERR")
+20 ;IHS/OIT/NKD AG*7.1*11 CHANGED SETTING OF TMP GLOBAL TO INCLUDE OFFSET AND ADDED 2 NEW ENTRIES
+21 ;S OVERSTAT=$S(OVERSTAT="A":1_U_OVERSTAT,OVERSTAT="D":2_U_OVERSTAT,OVERSTAT="R":3_U_OVERSTAT,OVERSTAT="RE":4_U_OVERSTAT,OVERSTAT="F":5_U_OVERSTAT,OVERSTAT="E":6_U_OVERSTAT,OVERSTAT="P":7_U_OVERSTAT,1:"UNDEFINED")
+22 SET OVERSTAT=$SELECT(OVERSTAT="A":17_U_OVERSTAT,OVERSTAT="D":25_U_OVERSTAT,OVERSTAT="R":32_U_OVERSTAT,OVERSTAT="RE":39_U_OVERSTAT,OVERSTAT="F":47_U_OVERSTAT,OVERSTAT="E":54_U_OVERSTAT,OVERSTAT="P":60_U_OVERSTAT,1:OVERSTA
T)
+23 IF OVERSTAT'[U
SET OVERSTAT=$SELECT(OVERSTAT="O":68_U_OVERSTAT,OVERSTAT="S":75_U_OVERSTAT,1:"UNDEFINED")
+24 SET SUB3=$SELECT(AGRPTTYP="APPTYPE":AGTYPE,1:PERSREC)
+25 IF SUB3=""
SET SUB3="UNPOPULATED"
+26 SET ^XTMP("AGBENPRD",$JOB,SUB3,OVERSTAT)=$GET(^XTMP("AGBENPRD",$JOB,SUB3,OVERSTAT))+1
+27 SET ^XTMP("AGBENPRD",$JOB,"~",OVERSTAT)=$GET(^XTMP("AGBENPRD",$JOB,"~",OVERSTAT))+1
End DoDot:3
End DoDot:2
End DoDot:1
+28 QUIT
PRINT ;
+1 DO HDR
+2 DO SUBHDR
+3 SET APPTYPE=""
+4 NEW ESC
+5 ;F S APPTYPE=$O(^XTMP("AGBENPRD",$J,APPTYPE)) Q:APPTYPE=""!(APPTYPE="~") D
+6 ;AG*7.1*7/IHS/SD/AR 02/23/2010
+7 FOR
SET APPTYPE=$ORDER(^XTMP("AGBENPRD",$JOB,APPTYPE))
IF APPTYPE=""!(APPTYPE="~")!$GET(ESC)
QUIT
Begin DoDot:1
+8 WRITE !,$EXTRACT(APPTYPE,1,15)
+9 SET OVERSTAT=""
+10 FOR
SET OVERSTAT=$ORDER(^XTMP("AGBENPRD",$JOB,APPTYPE,OVERSTAT))
IF OVERSTAT=""
QUIT
Begin DoDot:2
+11 SET STATUS=$PIECE(OVERSTAT,U,2)
+12 ;IHS/OIT/NKD AG*7.1*11 CHANGED $S FOR OFFSET TO USE 1ST PIECE IN TMP GLOBAL
+13 ;S OFFSET=$S(STATUS="A":18,STATUS="D":28,STATUS="R":37,STATUS="RE":47,STATUS="F":58,STATUS="E":66,STATUS="P":75,1:0)
+14 SET OFFSET=+$PIECE(OVERSTAT,U,1)
+15 ;I '$D(ZTQUEUED) I ($Y>(IOSL-4)!($Y=(IOSL-4))),(IOST[("C-")) W !! K DIR S DIR(0)="E" D ^DIR D HDR,SUBHDR Q
+16 ;AG*7.1*7/IHS/SD/AR 02/23/2010
+17 IF '$DATA(ZTQUEUED)
IF ($Y>(IOSL-4)!($Y=(IOSL-4)))
IF (IOST[("C-"))
WRITE !!
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET ESC=X=U
DO HDR
DO SUBHDR
QUIT
+18 IF ($Y>(IOSL-4)!($Y=(IOSL-4)))
IF (IOST'[("C-"))
DO HDR
DO SUBHDR
+19 WRITE ?OFFSET,$GET(^XTMP("AGBENPRD",$JOB,APPTYPE,OVERSTAT))
End DoDot:2
End DoDot:1
+20 IF $GET(ESC)
KILL ^XTMP("AGBENPRD",$JOB)
QUIT
+21 WRITE !!,AGDASH
+22 WRITE !,"TOTALS"
+23 SET OVERSTAT=""
+24 FOR
SET OVERSTAT=$ORDER(^XTMP("AGBENPRD",$JOB,"~",OVERSTAT))
IF OVERSTAT=""
QUIT
Begin DoDot:1
+25 IF OVERSTAT=0
QUIT
+26 IF STATUS="UNDEFINED"
QUIT
+27 SET STATUS=$PIECE(OVERSTAT,U,2)
+28 ;IHS/OIT/NKD AG*7.1*11 CHANGED $S FOR OFFSET TO USE 1ST PIECE IN TMP GLOBAL
+29 ;S OFFSET=$S(STATUS="A":18,STATUS="D":28,STATUS="R":37,STATUS="RE":47,STATUS="F":58,STATUS="E":66,STATUS="P":75,1:0)
+30 SET OFFSET=+$PIECE(OVERSTAT,U,1)
+31 WRITE ?OFFSET,$GET(^XTMP("AGBENPRD",$JOB,"~",OVERSTAT))
End DoDot:1
+32 DO ^%ZISC
+33 IF '$DATA(ZTQUEUED)
IF $Y>IOSL-4
IF (IOST[("C-"))
WRITE !!
KILL DIR
SET DIR(0)="E"
DO ^DIR
+34 KILL ^XTMP("AGBENPRD",$JOB)
+35 QUIT
INIT ;
+1 SET AGUSER=$PIECE($GET(^VA(200,DUZ,0)),U)
+2 ;S AGLOC=$P($G(^AUTTLOC(DUZ(2),0)),U,2)
+3 ;AG*7.1*4 DIDN'T WANT SHORT NAME
SET AGLOC=$PIECE($GET(^AUTTLOC(DUZ(2),0)),U)
+4 SET AGRPTNAM="BENEFIT COORDINATOR PRODUCTIVITY REPORT"
+5 XECUTE ^%ZOSF("UCI")
SET AGUCI=Y
+6 DO NOW^%DTC
+7 SET Y=%
XECUTE ^DD("DD")
+8 SET AGRPTDT=Y
+9 SET AGPAGE=0
+10 SET $PIECE(AGDASH,"-",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 ;W !,$$C^XBFUNC("Date range From "_AGBEGX) W " to ",AGENDX
+10 WRITE !,$$C^XBFUNC(STR)
+11 QUIT
SUBHDR ;
+1 WRITE !!
+2 WRITE $SELECT(AGRPTTYP="RECEIVER":"PERSON",1:"APPLICATION")
+3 ;IHS/OIT/NKD AG*7.1*11 ABBREVIATED COLUMN HEADERS TO FIT ADDITIONAL ENTRIES
+4 ;W ?36,"RE-",?53,"FOLLOWUP",?63,"ENTERED"
+5 WRITE !
+6 WRITE $SELECT(AGRPTTYP="RECEIVER":"RECEIVING",1:"TYPE")
+7 ;IHS/OIT/NKD AG*7.1*11 ABBREVIATED COLUMN HEADERS TO FIT ADDITIONAL ENTRIES
+8 ;W ?14,"APPROVED",?24,"DENIED",?33,"SUBMITTED",?43,"REFUSED",?54,"NEEDED",?62,"IN ERROR",?72,"PENDING"
+9 WRITE ?14,"APPROVED",?23,"DENIED",?30,"RESUB",?36,"REFUSED",?44,"FOLLOWUP",?53,"ERR",?57,"PENDING",?65,"OVERINC",?73,"SCREEN"
+10 WRITE !,AGDASH
+11 WRITE !
+12 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^AGBENPRD"
SET ZTDESC=AGRPTNAM
+7 SET ZTSAVE("AG*")=""
+8 DO ^%ZTLOAD
+9 QUIT
