ACHSRGPR ;IHS/OIT/FCJ - GPRA REPORT DOS VS DATE PO ISS
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
;
;Auth end DOS used, if not available then Auth Beg DOS
ST ;
S ACHSIO=IO
W !!,"This is a GPRA report to calculate the days between the Date of Service"
W !,"and when the Purchase Order was issued. Date of Service is the estimated"
W !,"End Date of Service, even if the document has been paid."
W !!,"The Purchase Order will either be selected by Fiscal Year or the Date of"
W !,"Service to fall within the Fiscal year Beginning and Ending date."
W !!,"The report is selected and sorted by issue date."
;
FY ; Select FY.
S ACHSACFY=$$FYSEL^ACHS(1)
G:$D(DTOUT)!$D(DUOUT) EXT
I '$D(^ACHS(9,DUZ(2),"FY",ACHSACFY)) W !!,*7,"Fiscal year '",ACHSACFY,"' does not exist. -- TRY AGAIN" G FY
FYDT ;BEG AND END DATES FOR THE FY, DOS >ACHSBFY OR <ACHSEFY
I $P(^ACHSF(DUZ(2),0),U,7)=1 S ACHSBFY=ACHSACFY-1701_($P(^ACHSF(DUZ(2),0),U,6)-1),ACHSEFY=ACHSACFY-1700_($P(^ACHSF(DUZ(2),0),U,6)-1)
E S ACHSBFY=ACHSACFY-1700_($P(^ACHSF(DUZ(2),0),U,6)-1),ACHSEFY=ACHSACFY-1699_($P(^ACHSF(DUZ(2),0),U,6)-1)
;
BDT ; Enter beginning date.
S ACHSBDT=$$DATE^ACHS("B","GPRA","")
G EXT:$D(DUOUT)!$D(DTOUT)!(ACHSBDT<1)
EDT ; Enter the ending date.
S ACHSEDT=$$DATE^ACHS("E","GPRA","")
G BDT:$D(DUOUT),EXT:$D(DTOUT)!(ACHSEDT<1),EDT:$$EBB^ACHS(ACHSBDT,ACHSEDT)
DOS ; REPORT BY DOS WITHIN FY OR FY
; Enter FY or DOS
S ACHSRTYD="F"
S DIR(0)="S^F:Fiscal Year;D:Date of Service",DIR("B")="Fiscal Year",DIR("A")="Report PO's by "
S DIR("?")="Report PO's by FY or by Date of service for sites that move money forward into one FY account."
D ^DIR
G EXT:$D(DUOUT),EXT:$D(DTOUT),EXT:$D(DIROUT)
S ACHSRTYD=Y
TYPE ; TYPE OF REPORT SUMARRY OR DETAILED
; Enter Summary or Detail
S DIR(0)="S^S:SUMMARY;D:DETAILED",DIR("A")="Report Type ",DIR("B")="SUMMARY"
S DIR("?")="Detail will display indiviual PO, Summary will display only the totals"
D ^DIR
G EXT:$D(DUOUT),EXT:$D(DTOUT),EXT:$D(DIROUT)
S ACHSRTYP=Y
DEV ; Select device for report.
W !
S %=$$PB^ACHS
I %=U!$D(DTOUT)!$D(DUOUT) G EXT
I %="B" D VIEWR^XBLM("CALC^ACHSRGPR"),EN^XBVK("VALM") G EXT
K IOP,%ZIS
S %ZIS="PQ"
D ^%ZIS,SLV^ACHSFU:$D(IO("S"))
K %ZIS
I POP W !,*7,"No device specified." D HOME^%ZIS G EXT
G:'$D(IO("Q")) CALC
K IO("Q")
I $E(IOST)'="P" W *7,!,"Please queue to printers only." G DEV
S ZTIO="",ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL,ZTRTN="CALC^ACHSRGPR",ZTDESC="CHS GPRA Report, "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)
F %="ACHSQIO","ACHSBDT","ACHSEDT","ACHSRTYP","ACHSACFY","ACHSEFY","ACHSBFY","ACHSRTYD" S ZTSAVE(%)=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
;
;end of interactive portion. The rest performed by Taskman
;
;
CALC ;EP - TaskMan.
D FC^ACHSUF
I $D(ACHSERR),ACHSERR=1 G EXT
S ACHSTRDT=ACHSBDT-1
K ^TMP("ACHSRGPR",$J)
S (^TMP("ACHSRGPR",$J,"TOTDOC"),^TMP("ACHSRGPR",$J,"TOTPDOC"),^TMP("ACHSRGPR",$J,"TOTADOC"))=0
S (^TMP("ACHSRGPR",$J,"TOTDAY"),^TMP("ACHSRGPR",$J,"TOTPDAY"),^TMP("ACHSRGPR",$J,"TOTADAY"))=0
;
TRDT ; Loop thru transaction date x-ref.
F S ACHSTRDT=$O(^ACHSF(DUZ(2),"TB",ACHSTRDT)) Q:(ACHSTRDT>ACHSEDT)!(ACHSTRDT'?1N.N) D
.; Loop thru transaction type
.S ACHSTYPE=""
.F S ACHSTYPE=$O(^ACHSF(DUZ(2),"TB",ACHSTRDT,ACHSTYPE)) Q:ACHSTYPE="" D
..Q:ACHSTYPE'="I"
..S DA=0
..F S DA=$O(^ACHSF(DUZ(2),"TB",ACHSTRDT,ACHSTYPE,DA)) Q:DA'?1N.N D
...Q:('$D(^ACHSF(DUZ(2),"D",DA,0)))!($P(^ACHSF(DUZ(2),"D",DA,0),U,12)=4) ;QUIT IF CANCELLED
...I ACHSRTYD="F" Q:ACHSACFY'=$P(^ACHSF(DUZ(2),"D",DA,0),U,27) ;IF REPORT BY FY TEST FOR FY
...S ACHSDOCN=$P(^ACHSF(DUZ(2),"D",DA,0),U),(X1,ACHSORDT)=$P(^(0),U,2)
...D DOSDT
...;S (X2,ACHSEDOS)=$S($P(^ACHSF(DUZ(2),"D",DA,3),U,2)'="":$P(^ACHSF(DUZ(2),"D",DA,3),U,2),1:$P(^ACHSF(DUZ(2),"D",DA,3),U))
...I ACHSRTYD="D" Q:(ACHSEDOS<ACHSBFY)!(ACHSEDOS>ACHSEFY) ;IF REPORT BY DOS TEST FOR DOS
...D ^%DTC
...S ACHSORDT=$E(ACHSORDT,4,5)_"/"_$E(ACHSORDT,6,7)_"/"_$E(ACHSORDT,2,3)
...S ACHSEDOS=$E(ACHSEDOS,4,5)_"/"_$E(ACHSEDOS,6,7)_"/"_$E(ACHSEDOS,2,3)
...I ACHSRTYP="D" D
....S ^TMP("ACHSRGPR",$J,ACHSDOCN)=$E(ACHSACFY,3,4)_"-"_ACHSFC_"-"_ACHSDOCN_U_ACHSEDOS_U_ACHSORDT
....I X>0 S $P(^TMP("ACHSRGPR",$J,ACHSDOCN),U,5)=X
....E S $P(^TMP("ACHSRGPR",$J,ACHSDOCN),U,4)=$FN(X,"-")
...I X>0 S ^TMP("ACHSRGPR",$J,"TOTADAY")=^TMP("ACHSRGPR",$J,"TOTADAY")+X,^("TOTADOC")=^("TOTADOC")+1
...E S ^TMP("ACHSRGPR",$J,"TOTPDAY")=^TMP("ACHSRGPR",$J,"TOTPDAY")+$FN(X,"-"),^("TOTPDOC")=^("TOTPDOC")+1
...S ^TMP("ACHSRGPR",$J,"TOTDOC")=^TMP("ACHSRGPR",$J,"TOTDOC")+1
...S ^TMP("ACHSRGPR",$J,"TOTDAY")=^TMP("ACHSRGPR",$J,"TOTDAY")+X
D PRINT
;
EXT ; Kill vars, close device, quit.
I $D(IO("S")) X ACHSPPC
E D ^%ZISC
D EN^XBVK("ACHS"),^ACHSVAR:'$D(ZTQUEUED)
K ^TMP("ACHSRGPR",$J)
K DTOUT,DUOUT,ZTSK
Q
;
DOSDT ;FIND THE DOS TO USE
;TEST FOR PAID DOCUMENT, USE ACT DOS OR EST EDOS IF NOT DEFINED USE EST BEG DOS
S X2=""
I $P(^ACHSF(DUZ(2),"D",DA,0),U,12)=3 D
.S T=0 F S T=$O(^ACHSF(DUZ(2),"D",DA,"T",T)) Q:T'?1N.N I $P(^ACHSF(DUZ(2),"D",DA,"T",T,0),U,2)="P" S (X2,ACHSEDOS)=$P(^(0),U,10) Q
I X2="" S (X2,ACHSEDOS)=$S($P(^ACHSF(DUZ(2),"D",DA,3),U,2)'="":$P(^ACHSF(DUZ(2),"D",DA,3),U,2),1:$P(^ACHSF(DUZ(2),"D",DA,3),U)) ;EDOS="" use EST Beg DOS
Q
;
PRINT ;
S ACHSVNDR="",ACHST1=$$C^XBFUNC("GPRA REPORT-AVERAGE DAYS BETWEEN PO ISSUE AND DOS")
S ACHST2=$$C^XBFUNC("For the period "_$$FMTE^XLFDT(ACHSBDT)_" through "_$$FMTE^XLFDT(ACHSEDT)),X3=0
D BRPT^ACHSFU
X:$D(IO("S")) ACHSPPO
D:ACHSRTYP="D" HDR,DET
S ACHSRTYP="S" D HDR,SUM
G EXT Q
;
DET ;DETAILED REPORT
S ACHSDOCN=""
F S ACHSDOCN=$O(^TMP("ACHSRGPR",$J,ACHSDOCN)) Q:ACHSDOCN'?1N.N D Q:$D(DUOUT)!$D(DTOUT)
.W !,$P(^TMP("ACHSRGPR",$J,ACHSDOCN),U),?19,$P(^(ACHSDOCN),U,2),?35,$P(^(ACHSDOCN),U,3),?51,$J($P(^(ACHSDOCN),U,4),5),?65,$J($P(^(ACHSDOCN),U,5),5)
.I $Y>ACHSBM D RTRN^ACHS Q:$D(DUOUT)!$D(DTOUT) D HDR
Q
SUM ;SUMMARY REPORT
;
W !!,"TOTAL Documents: ",$J(^TMP("ACHSRGPR",$J,"TOTDOC"),10)
W !,"TOTAL Days: ",?18,$J(^TMP("ACHSRGPR",$J,"TOTDAY"),10)
S ACHSAVG=0
I ^TMP("ACHSRGPR",$J,"TOTDOC") S ACHSAVG=$S(^TMP("ACHSRGPR",$J,"TOTDOC")>0:^TMP("ACHSRGPR",$J,"TOTDAY")/^TMP("ACHSRGPR",$J,"TOTDOC"),1:0)
W !,"Average Days: ",?18,$J(ACHSAVG,10,2),!
W !!,"TOTAL Documents Prior or = to DOS: ",?37,$J(^TMP("ACHSRGPR",$J,"TOTPDOC"),10)
W !,"TOTAL Days for Prior or = to DOS: ",?37,$J(^TMP("ACHSRGPR",$J,"TOTPDAY"),10)
S ACHSAVG=0
I ^TMP("ACHSRGPR",$J,"TOTPDOC")>0 S ACHSAVG=$S(^TMP("ACHSRGPR",$J,"TOTDOC")>0:^TMP("ACHSRGPR",$J,"TOTPDAY")/^TMP("ACHSRGPR",$J,"TOTPDOC"),1:0)
W !,"Average Days Prior or = to DOS: ",?37,$J(ACHSAVG,10,2),!
W !!,"TOTAL Documents After DOS: ",?28,$J(^TMP("ACHSRGPR",$J,"TOTADOC"),10)
W !,"TOTAL Days After DOS: ",?28,$J(^TMP("ACHSRGPR",$J,"TOTADAY"),10)
S ACHSAVG=0
I ^TMP("ACHSRGPR",$J,"TOTADOC"),1>0 S ACHSAVG=$S(^TMP("ACHSRGPR",$J,"TOTDOC")>0:^TMP("ACHSRGPR",$J,"TOTADAY")/^TMP("ACHSRGPR",$J,"TOTADOC"),1:0)
W !,"Average Days After DOS: ",?28,$J(ACHSAVG,10,2),!
Q
;
HDR ; Paginate.
S ACHSPG=ACHSPG+1
W @IOF,!!?19,"*** CONTRACT HEALTH MANAGEMENT SYSTEM ***",!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,ACHSLOC,!,ACHST1,!,ACHSTIME,!,ACHST2
I ACHSRTYP="D" D
.W !!,?50,"Days Prior",?64,"Days After"
.W !,"PO Number",?16,"Date of Service",?33,"Date of Issue",?49,"or = to DOS",?67,"DOS"
W !,$$REPEAT^XLFSTR("=",79),!
Q
ACHSRGPR ;IHS/OIT/FCJ - GPRA REPORT DOS VS DATE PO ISS
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
+2 ;
+3 ;Auth end DOS used, if not available then Auth Beg DOS
ST ;
+1 SET ACHSIO=IO
+2 WRITE !!,"This is a GPRA report to calculate the days between the Date of Service"
+3 WRITE !,"and when the Purchase Order was issued. Date of Service is the estimated"
+4 WRITE !,"End Date of Service, even if the document has been paid."
+5 WRITE !!,"The Purchase Order will either be selected by Fiscal Year or the Date of"
+6 WRITE !,"Service to fall within the Fiscal year Beginning and Ending date."
+7 WRITE !!,"The report is selected and sorted by issue date."
+8 ;
FY ; Select FY.
+1 SET ACHSACFY=$$FYSEL^ACHS(1)
+2 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXT
+3 IF '$DATA(^ACHS(9,DUZ(2),"FY",ACHSACFY))
WRITE !!,*7,"Fiscal year '",ACHSACFY,"' does not exist. -- TRY AGAIN"
GOTO FY
FYDT ;BEG AND END DATES FOR THE FY, DOS >ACHSBFY OR <ACHSEFY
+1 IF $PIECE(^ACHSF(DUZ(2),0),U,7)=1
SET ACHSBFY=ACHSACFY-1701_($PIECE(^ACHSF(DUZ(2),0),U,6)-1)
SET ACHSEFY=ACHSACFY-1700_($PIECE(^ACHSF(DUZ(2),0),U,6)-1)
+2 IF '$TEST
SET ACHSBFY=ACHSACFY-1700_($PIECE(^ACHSF(DUZ(2),0),U,6)-1)
SET ACHSEFY=ACHSACFY-1699_($PIECE(^ACHSF(DUZ(2),0),U,6)-1)
+3 ;
BDT ; Enter beginning date.
+1 SET ACHSBDT=$$DATE^ACHS("B","GPRA","")
+2 IF $DATA(DUOUT)!$DATA(DTOUT)!(ACHSBDT<1)
GOTO EXT
EDT ; Enter the ending date.
+1 SET ACHSEDT=$$DATE^ACHS("E","GPRA","")
+2 IF $DATA(DUOUT)
GOTO BDT
IF $DATA(DTOUT)!(ACHSEDT<1)
GOTO EXT
IF $$EBB^ACHS(ACHSBDT,ACHSEDT)
GOTO EDT
DOS ; REPORT BY DOS WITHIN FY OR FY
+1 ; Enter FY or DOS
+2 SET ACHSRTYD="F"
+3 SET DIR(0)="S^F:Fiscal Year;D:Date of Service"
SET DIR("B")="Fiscal Year"
SET DIR("A")="Report PO's by "
+4 SET DIR("?")="Report PO's by FY or by Date of service for sites that move money forward into one FY account."
+5 DO ^DIR
+6 IF $DATA(DUOUT)
GOTO EXT
IF $DATA(DTOUT)
GOTO EXT
IF $DATA(DIROUT)
GOTO EXT
+7 SET ACHSRTYD=Y
TYPE ; TYPE OF REPORT SUMARRY OR DETAILED
+1 ; Enter Summary or Detail
+2 SET DIR(0)="S^S:SUMMARY;D:DETAILED"
SET DIR("A")="Report Type "
SET DIR("B")="SUMMARY"
+3 SET DIR("?")="Detail will display indiviual PO, Summary will display only the totals"
+4 DO ^DIR
+5 IF $DATA(DUOUT)
GOTO EXT
IF $DATA(DTOUT)
GOTO EXT
IF $DATA(DIROUT)
GOTO EXT
+6 SET ACHSRTYP=Y
DEV ; Select device for report.
+1 WRITE !
+2 SET %=$$PB^ACHS
+3 IF %=U!$DATA(DTOUT)!$DATA(DUOUT)
GOTO EXT
+4 IF %="B"
DO VIEWR^XBLM("CALC^ACHSRGPR")
DO EN^XBVK("VALM")
GOTO EXT
+5 KILL IOP,%ZIS
+6 SET %ZIS="PQ"
+7 DO ^%ZIS
IF $DATA(IO("S"))
DO SLV^ACHSFU
+8 KILL %ZIS
+9 IF POP
WRITE !,*7,"No device specified."
DO HOME^%ZIS
GOTO EXT
+10 IF '$DATA(IO("Q"))
GOTO CALC
+11 KILL IO("Q")
+12 IF $EXTRACT(IOST)'="P"
WRITE *7,!,"Please queue to printers only."
GOTO DEV
+13 SET ZTIO=""
SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
SET ZTRTN="CALC^ACHSRGPR"
SET ZTDESC="CHS GPRA Report, "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)
+14 FOR %="ACHSQIO","ACHSBDT","ACHSEDT","ACHSRTYP","ACHSACFY","ACHSEFY","ACHSBFY","ACHSRTYD"
SET ZTSAVE(%)=""
+15 DO ^%ZTLOAD
+16 IF '$DATA(ZTSK)
GOTO DEV
+17 ;
+18 ;end of interactive portion. The rest performed by Taskman
+19 ;
+20 ;
CALC ;EP - TaskMan.
+1 DO FC^ACHSUF
+2 IF $DATA(ACHSERR)
IF ACHSERR=1
GOTO EXT
+3 SET ACHSTRDT=ACHSBDT-1
+4 KILL ^TMP("ACHSRGPR",$JOB)
+5 SET (^TMP("ACHSRGPR",$JOB,"TOTDOC"),^TMP("ACHSRGPR",$JOB,"TOTPDOC"),^TMP("ACHSRGPR",$JOB,"TOTADOC"))=0
+6 SET (^TMP("ACHSRGPR",$JOB,"TOTDAY"),^TMP("ACHSRGPR",$JOB,"TOTPDAY"),^TMP("ACHSRGPR",$JOB,"TOTADAY"))=0
+7 ;
TRDT ; Loop thru transaction date x-ref.
+1 FOR
SET ACHSTRDT=$ORDER(^ACHSF(DUZ(2),"TB",ACHSTRDT))
IF (ACHSTRDT>ACHSEDT)!(ACHSTRDT'?1N.N)
QUIT
Begin DoDot:1
+2 ; Loop thru transaction type
+3 SET ACHSTYPE=""
+4 FOR
SET ACHSTYPE=$ORDER(^ACHSF(DUZ(2),"TB",ACHSTRDT,ACHSTYPE))
IF ACHSTYPE=""
QUIT
Begin DoDot:2
+5 IF ACHSTYPE'="I"
QUIT
+6 SET DA=0
+7 FOR
SET DA=$ORDER(^ACHSF(DUZ(2),"TB",ACHSTRDT,ACHSTYPE,DA))
IF DA'?1N.N
QUIT
Begin DoDot:3
+8 ;QUIT IF CANCELLED
IF ('$DATA(^ACHSF(DUZ(2),"D",DA,0)))!($PIECE(^ACHSF(DUZ(2),"D",DA,0),U,12)=4)
QUIT
+9 ;IF REPORT BY FY TEST FOR FY
IF ACHSRTYD="F"
IF ACHSACFY'=$PIECE(^ACHSF(DUZ(2),"D",DA,0),U,27)
QUIT
+10 SET ACHSDOCN=$PIECE(^ACHSF(DUZ(2),"D",DA,0),U)
SET (X1,ACHSORDT)=$PIECE(^(0),U,2)
+11 DO DOSDT
+12 ;S (X2,ACHSEDOS)=$S($P(^ACHSF(DUZ(2),"D",DA,3),U,2)'="":$P(^ACHSF(DUZ(2),"D",DA,3),U,2),1:$P(^ACHSF(DUZ(2),"D",DA,3),U))
+13 ;IF REPORT BY DOS TEST FOR DOS
IF ACHSRTYD="D"
IF (ACHSEDOS<ACHSBFY)!(ACHSEDOS>ACHSEFY)
QUIT
+14 DO ^%DTC
+15 SET ACHSORDT=$EXTRACT(ACHSORDT,4,5)_"/"_$EXTRACT(ACHSORDT,6,7)_"/"_$EXTRACT(ACHSORDT,2,3)
+16 SET ACHSEDOS=$EXTRACT(ACHSEDOS,4,5)_"/"_$EXTRACT(ACHSEDOS,6,7)_"/"_$EXTRACT(ACHSEDOS,2,3)
+17 IF ACHSRTYP="D"
Begin DoDot:4
+18 SET ^TMP("ACHSRGPR",$JOB,ACHSDOCN)=$EXTRACT(ACHSACFY,3,4)_"-"_ACHSFC_"-"_ACHSDOCN_U_ACHSEDOS_U_ACHSORDT
+19 IF X>0
SET $PIECE(^TMP("ACHSRGPR",$JOB,ACHSDOCN),U,5)=X
+20 IF '$TEST
SET $PIECE(^TMP("ACHSRGPR",$JOB,ACHSDOCN),U,4)=$FNUMBER(X,"-")
End DoDot:4
+21 IF X>0
SET ^TMP("ACHSRGPR",$JOB,"TOTADAY")=^TMP("ACHSRGPR",$JOB,"TOTADAY")+X
SET ^("TOTADOC")=^("TOTADOC")+1
+22 IF '$TEST
SET ^TMP("ACHSRGPR",$JOB,"TOTPDAY")=^TMP("ACHSRGPR",$JOB,"TOTPDAY")+$FNUMBER(X,"-")
SET ^("TOTPDOC")=^("TOTPDOC")+1
+23 SET ^TMP("ACHSRGPR",$JOB,"TOTDOC")=^TMP("ACHSRGPR",$JOB,"TOTDOC")+1
+24 SET ^TMP("ACHSRGPR",$JOB,"TOTDAY")=^TMP("ACHSRGPR",$JOB,"TOTDAY")+X
End DoDot:3
End DoDot:2
End DoDot:1
+25 DO PRINT
+26 ;
EXT ; Kill vars, close device, quit.
+1 IF $DATA(IO("S"))
XECUTE ACHSPPC
+2 IF '$TEST
DO ^%ZISC
+3 DO EN^XBVK("ACHS")
IF '$DATA(ZTQUEUED)
DO ^ACHSVAR
+4 KILL ^TMP("ACHSRGPR",$JOB)
+5 KILL DTOUT,DUOUT,ZTSK
+6 QUIT
+7 ;
DOSDT ;FIND THE DOS TO USE
+1 ;TEST FOR PAID DOCUMENT, USE ACT DOS OR EST EDOS IF NOT DEFINED USE EST BEG DOS
+2 SET X2=""
+3 IF $PIECE(^ACHSF(DUZ(2),"D",DA,0),U,12)=3
Begin DoDot:1
+4 SET T=0
FOR
SET T=$ORDER(^ACHSF(DUZ(2),"D",DA,"T",T))
IF T'?1N.N
QUIT
IF $PIECE(^ACHSF(DUZ(2),"D",DA,"T",T,0),U,2)="P"
SET (X2,ACHSEDOS)=$PIECE(^(0),U,10)
QUIT
End DoDot:1
+5 ;EDOS="" use EST Beg DOS
IF X2=""
SET (X2,ACHSEDOS)=$SELECT($PIECE(^ACHSF(DUZ(2),"D",DA,3),U,2)'="":$PIECE(^ACHSF(DUZ(2),"D",DA,3),U,2),1:$PIECE(^ACHSF(DUZ(2),"D",DA,3),U))
+6 QUIT
+7 ;
PRINT ;
+1 SET ACHSVNDR=""
SET ACHST1=$$C^XBFUNC("GPRA REPORT-AVERAGE DAYS BETWEEN PO ISSUE AND DOS")
+2 SET ACHST2=$$C^XBFUNC("For the period "_$$FMTE^XLFDT(ACHSBDT)_" through "_$$FMTE^XLFDT(ACHSEDT))
SET X3=0
+3 DO BRPT^ACHSFU
+4 IF $DATA(IO("S"))
XECUTE ACHSPPO
+5 IF ACHSRTYP="D"
DO HDR
DO DET
+6 SET ACHSRTYP="S"
DO HDR
DO SUM
+7 GOTO EXT
QUIT
+8 ;
DET ;DETAILED REPORT
+1 SET ACHSDOCN=""
+2 FOR
SET ACHSDOCN=$ORDER(^TMP("ACHSRGPR",$JOB,ACHSDOCN))
IF ACHSDOCN'?1N.N
QUIT
Begin DoDot:1
+3 WRITE !,$PIECE(^TMP("ACHSRGPR",$JOB,ACHSDOCN),U),?19,$PIECE(^(ACHSDOCN),U,2),?35,$PIECE(^(ACHSDOCN),U,3),?51,$JUSTIFY($PIECE(^(ACHSDOCN),U,4),5),?65,$JUSTIFY($PIECE(^(ACHSDOCN),U,5),5)
+4 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
DO HDR
End DoDot:1
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+5 QUIT
SUM ;SUMMARY REPORT
+1 ;
+2 WRITE !!,"TOTAL Documents: ",$JUSTIFY(^TMP("ACHSRGPR",$JOB,"TOTDOC"),10)
+3 WRITE !,"TOTAL Days: ",?18,$JUSTIFY(^TMP("ACHSRGPR",$JOB,"TOTDAY"),10)
+4 SET ACHSAVG=0
+5 IF ^TMP("ACHSRGPR",$JOB,"TOTDOC")
SET ACHSAVG=$SELECT(^TMP("ACHSRGPR",$JOB,"TOTDOC")>0:^TMP("ACHSRGPR",$JOB,"TOTDAY")/^TMP("ACHSRGPR",$JOB,"TOTDOC"),1:0)
+6 WRITE !,"Average Days: ",?18,$JUSTIFY(ACHSAVG,10,2),!
+7 WRITE !!,"TOTAL Documents Prior or = to DOS: ",?37,$JUSTIFY(^TMP("ACHSRGPR",$JOB,"TOTPDOC"),10)
+8 WRITE !,"TOTAL Days for Prior or = to DOS: ",?37,$JUSTIFY(^TMP("ACHSRGPR",$JOB,"TOTPDAY"),10)
+9 SET ACHSAVG=0
+10 IF ^TMP("ACHSRGPR",$JOB,"TOTPDOC")>0
SET ACHSAVG=$SELECT(^TMP("ACHSRGPR",$JOB,"TOTDOC")>0:^TMP("ACHSRGPR",$JOB,"TOTPDAY")/^TMP("ACHSRGPR",$JOB,"TOTPDOC"),1:0)
+11 WRITE !,"Average Days Prior or = to DOS: ",?37,$JUSTIFY(ACHSAVG,10,2),!
+12 WRITE !!,"TOTAL Documents After DOS: ",?28,$JUSTIFY(^TMP("ACHSRGPR",$JOB,"TOTADOC"),10)
+13 WRITE !,"TOTAL Days After DOS: ",?28,$JUSTIFY(^TMP("ACHSRGPR",$JOB,"TOTADAY"),10)
+14 SET ACHSAVG=0
+15 IF ^TMP("ACHSRGPR",$JOB,"TOTADOC")
IF 1>0
SET ACHSAVG=$SELECT(^TMP("ACHSRGPR",$JOB,"TOTDOC")>0:^TMP("ACHSRGPR",$JOB,"TOTADAY")/^TMP("ACHSRGPR",$JOB,"TOTADOC"),1:0)
+16 WRITE !,"Average Days After DOS: ",?28,$JUSTIFY(ACHSAVG,10,2),!
+17 QUIT
+18 ;
HDR ; Paginate.
+1 SET ACHSPG=ACHSPG+1
+2 WRITE @IOF,!!?19,"*** CONTRACT HEALTH MANAGEMENT SYSTEM ***",!,ACHSUSR,?71,"Page",$JUSTIFY(ACHSPG,3),!,ACHSLOC,!,ACHST1,!,ACHSTIME,!,ACHST2
+3 IF ACHSRTYP="D"
Begin DoDot:1
+4 WRITE !!,?50,"Days Prior",?64,"Days After"
+5 WRITE !,"PO Number",?16,"Date of Service",?33,"Date of Issue",?49,"or = to DOS",?67,"DOS"
End DoDot:1
+6 WRITE !,$$REPEAT^XLFSTR("=",79),!
+7 QUIT
