ACKQCDRP ;AUG/JLTP BIR/PTD HCIOFO/AG -Print CDR Report ; [ 03/28/96 10:45 AM ]
;;3.0;QUASAR;;Feb 11, 2000
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
;
; This routine prints the CDR report either for a Site, or for an
; individual Division, for a specific Month.
;
K ACKDIV ; initialise Division array
;
; get CDR Generate flag (by site or division)
S ACKCDRP=$$GET1^DIQ(509850.8,"1,",.1,"I") ; either 'S' or 'D'
I ACKCDRP'="S",ACKCDRP'="D" G EXIT
;
OPTN ;Introduce option.
I ACKCDRP="S" D
. S ACKTXT(1)="This option prints the A&SP Service Cost Distribution report for your site,"
. S ACKTXT(2)="for a given month."
I ACKCDRP="D" D
. S ACKTXT(1)="This option prints the A&SP Service Cost Distribution report for a Division"
. S ACKTXT(2)="or multiple Divisions, for a given month."
W @IOF,!,ACKTXT(1),!,ACKTXT(2),!
;
; prompt for Division(s)
I ACKCDRP="D" S ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"AI") G:+ACKDIV=0 EXIT
;
; prompt for month
D GETDT G:$D(DIRUT) EXIT
S MON=$E(ACKM,1,5),ACKEM=MON_"99",ACKDA=+$$SITE^VASITE()_MON
S ACKBFY=$$BFY^ACKQUTL(ACKM)
;
; determine whether the cdr has been generated
S ACKEXIT=0
I ACKCDRP="D" D CHKDIV G:ACKEXIT EXIT
I ACKCDRP="S" D CHKSITE G:ACKEXIT EXIT
;
DEV ; select output device
W !!,"The right margin for this report is 80."
W !,"You can queue it to run at a later time.",!
K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS
I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." G EXIT
; if requested, add report to queue
I $D(IO("Q")) D G EXIT
. K IO("Q")
. S ZTRTN="DQ^ACKQCDRP",ZTDESC="QUASAR - Print A&SP Cost Distribution Report"
. S ZTSAVE("ACK*")="" D ^%ZTLOAD D HOME^%ZIS K ZTSK
;
DQ ;Entry point when queued.
U IO
D NOW^%DTC
S ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%),ACKPG=0
K ^TMP("ACKQCDRP",$J)
;
; print the report
I ACKCDRP="S" D COMPS,PRINT ; print for the site
I ACKCDRP="D" D ; print for each division
. S ACKDIV="" F S ACKDIV=$O(ACKDIV(ACKDIV)) Q:ACKDIV="" D COMPD,PRINT
;
EXIT ; ALWAYS EXIT HERE
K %I,ACKBFY,ACKCDT,ACKDA,ACKEM,ACKM,ACKPG,AS,CDR,CPT,DIR,DIRUT,DTOUT
K DUOUT,I,ICD,LN,T,X,XAS,Y,ZIP,^TMP("ACKQCDRP",$J)
K ACKTXT,ACKCDRP,ACKCDR,ACKCDRNM,ACKPCNT,ACKTOT,ACKTMP,ACKIEN,ACKTGT,ACKMSG
K ACKMORE,ACKCDRX,ACKEXIT,ACKDIV
W:$E(IOST)="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
;
COMPS ; compile data for the site
; walk down the CDR data for the site in the Workload file.
K ACKTGT,ACKMSG
S ACKFROM="" S ACKTOT=0,ACKMORE=0
F D Q:'ACKMORE
. S ACKMORE=0
. D LIST^DIC(509850.74,","_ACKDA_",",".01;.02","I",1,.ACKFROM,"","","","","ACKTGT","ACKMSG")
. I $P(ACKTGT("DILIST",0),U,1)=1 D ; one found
. . S ACKMORE=$P(ACKTGT("DILIST",0),U,3) ; there are more
. . S ACKCDR=ACKTGT("DILIST","ID",1,.01) ; cdr number
. . S ACKPCNT=ACKTGT("DILIST","ID",1,.02) ; percentage
. . S ACKIEN=$$FIND1^DIC(509850,"","O",ACKCDR,"B","","")
. . S ACKCDRNM=$$GET1^DIQ(509850,ACKIEN_",",1,"E") ; cdr description
. . S ^TMP("ACKQCDRP",$J,1,+ACKCDR)=ACKCDR_U_ACKCDRNM_U_ACKPCNT
Q
;
COMPD ; compile data for a division
; walk down the CDR data for the division in the Workload file.
K ACKTGT,ACKMSG,^TMP("ACKQCDRP",$J,1)
S ACKFROM="" S ACKTOT=0,ACKMORE=0
F D Q:'ACKMORE Q:$D(DIRUT)
. S ACKMORE=0
. D LIST^DIC(509850.754,","_ACKDIV_","_ACKDA_",",".01;54.02","I",1,.ACKFROM,"","","","","ACKTGT","ACKMSG")
. I $P(ACKTGT("DILIST",0),U,1)=1 D ; one found
. . S ACKMORE=$P(ACKTGT("DILIST",0),U,3) ; there are more
. . S ACKCDR=ACKTGT("DILIST","ID",1,.01) ; cdr number
. . S ACKPCNT=ACKTGT("DILIST","ID",1,54.02) ; percentage
. . S ACKIEN=$$FIND1^DIC(509850,"","O",ACKCDR,"B","","")
. . S ACKCDRNM=$$GET1^DIQ(509850,ACKIEN_",",1,"E") ; cdr description
. . S ^TMP("ACKQCDRP",$J,1,+ACKCDR)=ACKCDR_U_ACKCDRNM_U_ACKPCNT
Q
;
PRINT ; Print/display results for the Site/Division.
I ACKPG>0,$E(IOST)="C" D PAUSE^ACKQUTL Q:$D(DIRUT)
D DHD
I '$D(^TMP("ACKQCDRP",$J,1)) D LINE W !!,"No data found for report specifications." D:$E(IOST)="C" PAUSE^ACKQUTL Q
D HD4
CDR ; CDR information for site/Division
S ACKCDR="" F S ACKCDR=$O(^TMP("ACKQCDRP",$J,1,ACKCDR)) Q:ACKCDR="" D Q:$D(DIRUT)
. I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D DHD,HD4
. S ACKTMP=^TMP("ACKQCDRP",$J,1,ACKCDR)
. S ACKCDRX=$P(ACKTMP,U,1),ACKCDRNM=$P(ACKTMP,U,2),ACKPCNT=$P(ACKTMP,U,3)
. W !?5,ACKCDRX,?15,ACKCDRNM,?65,$J(ACKPCNT,6,2)
. S ACKTOT=ACKTOT+ACKPCNT
;
; print total
Q:$D(DIRUT)
W !!?5,"Total:",?65,$J(ACKTOT,6,2)
Q
;
DHD ;
N X
W:($E(IOST)="C")!(ACKPG>0) @IOF
S ACKPG=ACKPG+1
W "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
W ! D CNTR^ACKQUTL("Cost Distribution Report")
I ACKCDRP="S" W ! D CNTR^ACKQUTL("for")
I ACKCDRP="D" W ! D CNTR^ACKQUTL("for Division : "_$$GET1^DIQ(40.8,ACKDIV_",",.01,"E"))
W ! D CNTR^ACKQUTL($$XDAT^ACKQUTL(ACKM))
W !
Q
HD4 ; Header for CDR statistics.
N X
W !?5,"CDR ACCOUNT",?63,"% WORKLOAD"
D LINE
Q
LINE S X="",$P(X,"-",IOM)="-" W !,X
Q
CHKDIV ; Check the CDR has been generated for one Division for the month
N ACKERR S ACKERR=0
S ACKDIV="" F S ACKDIV=$O(ACKDIV(ACKDIV)) Q:ACKDIV="" D
. I '$$DIVCDR(ACKDA,ACKDIV) D
. . S ACKERR=ACKERR+1,ACKERR(ACKERR)=ACKDIV
. . K ACKDIV(ACKDIV)
;
; none left to be printed
I $O(ACKDIV(""))="" D S ACKEXIT=1 D:$E(IOST)="C" PAUSE^ACKQUTL Q
. W !!,"The CDR has not been generated for "_$$XDAT^ACKQUTL(ACKM)
. W " for any of the selected",!,"Divisions",!!
;
; at least one error
I ACKERR D
. W !!,"The CDR has not been generated for "_$$XDAT^ACKQUTL(ACKM)
. W " for the following Division"_$S(ACKERR>1:"s",1:"")
. F I=1:1:ACKERR W !?5,$$GET1^DIQ(40.8,ACKERR(I)_",",.01,"E")
;
; now list the Divisions that will be printed
W !!,"The CDR for "_$$XDAT^ACKQUTL(ACKM)_" will now print for the following Division"
W $S($O(ACKDIV(""))=$O(ACKDIV(""),-1):"",1:"s")
S ACKDIV="" F S ACKDIV=$O(ACKDIV(ACKDIV)) Q:ACKDIV="" D
. W !?5,$$GET1^DIQ(40.8,ACKDIV_",",.01,"E")
;
; End
Q
CHKSITE ; Check the CDR has been generated for the selected month
I '$$SITECDR(ACKDA) D
. W !!,"The CDR has not been generated for "_$$XDAT^ACKQUTL(ACKM)_".",!
. S ACKEXIT=1
Q
GETDT ; Select month for report.
N DIR,X,Y
GDT1 K DIR
S DIR(0)="D^::APE",DIR("A")="Select Month & Year"
S DIR("B")=$$XDAT^ACKQUTL($$LM(DT)),DIR("?")="^D HELP^%DTC"
S DIR("??")="^D DATHLP^ACKQCDRP"
D ^DIR
I Y?1"^"1.E W !,"Jumping not allowed.",! G GDT1
Q:$D(DIRUT)
S ACKM=$E(Y,1,5)_"00"
I ACKM>DT W !,"Can't run Cost Distribution Report for future months!",! G GDT1
Q
DATHLP ; Extended help - select month for CDR report.
W !?5,"Enter a date, in the past, for which you wish to"
W !?5,"print the Cost Distribution Report."
Q
LM(X) ;Find month previous to X.
N M,D,Y S M=$E(X,4,5),D=$E(X,6,7),Y=$E(X,1,3),M=M-1
S:M<1 M=12,Y=Y-1 S:M<10 M="0"_M
Q Y_M_"00"
DIVCDR(ACKDA,ACKDIV) ; check if CDR generated for ACKDA (month) and ACKDIV
N ACKTGT,ACKMSG,ACKFRM
D LIST^DIC(509850.754,","_ACKDIV_","_ACKDA_",","","",1,.ACKFRM,"","","","","ACKTGT","ACKMSG")
Q $P(ACKTGT("DILIST",0),U,1)=1
SITECDR(ACKDA) ; check is CDR generated for ACKDA (month) for the site
N ACKTGT,ACKMSG,ACKFRM
D LIST^DIC(509850.74,","_ACKDA_",","","",1,.ACKFRM,"","","","","ACKTGT","ACKMSG")
Q $P(ACKTGT("DILIST",0),U,1)=1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQCDRP 7489 printed Apr 09, 2024@21:35:01 Page 2
ACKQCDRP ;AUG/JLTP BIR/PTD HCIOFO/AG -Print CDR Report ; [ 03/28/96 10:45 AM ]
+1 ;;3.0;QUASAR;;Feb 11, 2000
+2 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 ;
+4 ; This routine prints the CDR report either for a Site, or for an
+5 ; individual Division, for a specific Month.
+6 ;
+7 ; initialise Division array
KILL ACKDIV
+8 ;
+9 ; get CDR Generate flag (by site or division)
+10 ; either 'S' or 'D'
SET ACKCDRP=$$GET1^DIQ(509850.8,"1,",.1,"I")
+11 IF ACKCDRP'="S"
IF ACKCDRP'="D"
GOTO EXIT
+12 ;
OPTN ;Introduce option.
+1 IF ACKCDRP="S"
Begin DoDot:1
+2 SET ACKTXT(1)="This option prints the A&SP Service Cost Distribution report for your site,"
+3 SET ACKTXT(2)="for a given month."
End DoDot:1
+4 IF ACKCDRP="D"
Begin DoDot:1
+5 SET ACKTXT(1)="This option prints the A&SP Service Cost Distribution report for a Division"
+6 SET ACKTXT(2)="or multiple Divisions, for a given month."
End DoDot:1
+7 WRITE @IOF,!,ACKTXT(1),!,ACKTXT(2),!
+8 ;
+9 ; prompt for Division(s)
+10 IF ACKCDRP="D"
SET ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"AI")
if +ACKDIV=0
GOTO EXIT
+11 ;
+12 ; prompt for month
+13 DO GETDT
if $DATA(DIRUT)
GOTO EXIT
+14 SET MON=$EXTRACT(ACKM,1,5)
SET ACKEM=MON_"99"
SET ACKDA=+$$SITE^VASITE()_MON
+15 SET ACKBFY=$$BFY^ACKQUTL(ACKM)
+16 ;
+17 ; determine whether the cdr has been generated
+18 SET ACKEXIT=0
+19 IF ACKCDRP="D"
DO CHKDIV
if ACKEXIT
GOTO EXIT
+20 IF ACKCDRP="S"
DO CHKSITE
if ACKEXIT
GOTO EXIT
+21 ;
DEV ; select output device
+1 WRITE !!,"The right margin for this report is 80."
+2 WRITE !,"You can queue it to run at a later time.",!
+3 KILL %ZIS,IOP
SET %ZIS="QM"
SET %ZIS("B")=""
DO ^%ZIS
+4 IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED."
GOTO EXIT
+5 ; if requested, add report to queue
+6 IF $DATA(IO("Q"))
Begin DoDot:1
+7 KILL IO("Q")
+8 SET ZTRTN="DQ^ACKQCDRP"
SET ZTDESC="QUASAR - Print A&SP Cost Distribution Report"
+9 SET ZTSAVE("ACK*")=""
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
+10 ;
DQ ;Entry point when queued.
+1 USE IO
+2 DO NOW^%DTC
+3 SET ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%)
SET ACKPG=0
+4 KILL ^TMP("ACKQCDRP",$JOB)
+5 ;
+6 ; print the report
+7 ; print for the site
IF ACKCDRP="S"
DO COMPS
DO PRINT
+8 ; print for each division
IF ACKCDRP="D"
Begin DoDot:1
+9 SET ACKDIV=""
FOR
SET ACKDIV=$ORDER(ACKDIV(ACKDIV))
if ACKDIV=""
QUIT
DO COMPD
DO PRINT
End DoDot:1
+10 ;
EXIT ; ALWAYS EXIT HERE
+1 KILL %I,ACKBFY,ACKCDT,ACKDA,ACKEM,ACKM,ACKPG,AS,CDR,CPT,DIR,DIRUT,DTOUT
+2 KILL DUOUT,I,ICD,LN,T,X,XAS,Y,ZIP,^TMP("ACKQCDRP",$JOB)
+3 KILL ACKTXT,ACKCDRP,ACKCDR,ACKCDRNM,ACKPCNT,ACKTOT,ACKTMP,ACKIEN,ACKTGT,ACKMSG
+4 KILL ACKMORE,ACKCDRX,ACKEXIT,ACKDIV
+5 if $EXTRACT(IOST)="C"
WRITE @IOF
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+6 QUIT
+7 ;
COMPS ; compile data for the site
+1 ; walk down the CDR data for the site in the Workload file.
+2 KILL ACKTGT,ACKMSG
+3 SET ACKFROM=""
SET ACKTOT=0
SET ACKMORE=0
+4 FOR
Begin DoDot:1
+5 SET ACKMORE=0
+6 DO LIST^DIC(509850.74,","_ACKDA_",",".01;.02","I",1,.ACKFROM,"","","","","ACKTGT","ACKMSG")
+7 ; one found
IF $PIECE(ACKTGT("DILIST",0),U,1)=1
Begin DoDot:2
+8 ; there are more
SET ACKMORE=$PIECE(ACKTGT("DILIST",0),U,3)
+9 ; cdr number
SET ACKCDR=ACKTGT("DILIST","ID",1,.01)
+10 ; percentage
SET ACKPCNT=ACKTGT("DILIST","ID",1,.02)
+11 SET ACKIEN=$$FIND1^DIC(509850,"","O",ACKCDR,"B","","")
+12 ; cdr description
SET ACKCDRNM=$$GET1^DIQ(509850,ACKIEN_",",1,"E")
+13 SET ^TMP("ACKQCDRP",$JOB,1,+ACKCDR)=ACKCDR_U_ACKCDRNM_U_ACKPCNT
End DoDot:2
End DoDot:1
if 'ACKMORE
QUIT
+14 QUIT
+15 ;
COMPD ; compile data for a division
+1 ; walk down the CDR data for the division in the Workload file.
+2 KILL ACKTGT,ACKMSG,^TMP("ACKQCDRP",$JOB,1)
+3 SET ACKFROM=""
SET ACKTOT=0
SET ACKMORE=0
+4 FOR
Begin DoDot:1
+5 SET ACKMORE=0
+6 DO LIST^DIC(509850.754,","_ACKDIV_","_ACKDA_",",".01;54.02","I",1,.ACKFROM,"","","","","ACKTGT","ACKMSG")
+7 ; one found
IF $PIECE(ACKTGT("DILIST",0),U,1)=1
Begin DoDot:2
+8 ; there are more
SET ACKMORE=$PIECE(ACKTGT("DILIST",0),U,3)
+9 ; cdr number
SET ACKCDR=ACKTGT("DILIST","ID",1,.01)
+10 ; percentage
SET ACKPCNT=ACKTGT("DILIST","ID",1,54.02)
+11 SET ACKIEN=$$FIND1^DIC(509850,"","O",ACKCDR,"B","","")
+12 ; cdr description
SET ACKCDRNM=$$GET1^DIQ(509850,ACKIEN_",",1,"E")
+13 SET ^TMP("ACKQCDRP",$JOB,1,+ACKCDR)=ACKCDR_U_ACKCDRNM_U_ACKPCNT
End DoDot:2
End DoDot:1
if 'ACKMORE
QUIT
if $DATA(DIRUT)
QUIT
+14 QUIT
+15 ;
PRINT ; Print/display results for the Site/Division.
+1 IF ACKPG>0
IF $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
+2 DO DHD
+3 IF '$DATA(^TMP("ACKQCDRP",$JOB,1))
DO LINE
WRITE !!,"No data found for report specifications."
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
QUIT
+4 DO HD4
CDR ; CDR information for site/Division
+1 SET ACKCDR=""
FOR
SET ACKCDR=$ORDER(^TMP("ACKQCDRP",$JOB,1,ACKCDR))
if ACKCDR=""
QUIT
Begin DoDot:1
+2 IF $Y>(IOSL-5)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO DHD
DO HD4
+3 SET ACKTMP=^TMP("ACKQCDRP",$JOB,1,ACKCDR)
+4 SET ACKCDRX=$PIECE(ACKTMP,U,1)
SET ACKCDRNM=$PIECE(ACKTMP,U,2)
SET ACKPCNT=$PIECE(ACKTMP,U,3)
+5 WRITE !?5,ACKCDRX,?15,ACKCDRNM,?65,$JUSTIFY(ACKPCNT,6,2)
+6 SET ACKTOT=ACKTOT+ACKPCNT
End DoDot:1
if $DATA(DIRUT)
QUIT
+7 ;
+8 ; print total
+9 if $DATA(DIRUT)
QUIT
+10 WRITE !!?5,"Total:",?65,$JUSTIFY(ACKTOT,6,2)
+11 QUIT
+12 ;
DHD ;
+1 NEW X
+2 if ($EXTRACT(IOST)="C")!(ACKPG>0)
WRITE @IOF
+3 SET ACKPG=ACKPG+1
+4 WRITE "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
+5 WRITE !
DO CNTR^ACKQUTL("Audiology & Speech Pathology")
+6 WRITE !
DO CNTR^ACKQUTL("Cost Distribution Report")
+7 IF ACKCDRP="S"
WRITE !
DO CNTR^ACKQUTL("for")
+8 IF ACKCDRP="D"
WRITE !
DO CNTR^ACKQUTL("for Division : "_$$GET1^DIQ(40.8,ACKDIV_",",.01,"E"))
+9 WRITE !
DO CNTR^ACKQUTL($$XDAT^ACKQUTL(ACKM))
+10 WRITE !
+11 QUIT
HD4 ; Header for CDR statistics.
+1 NEW X
+2 WRITE !?5,"CDR ACCOUNT",?63,"% WORKLOAD"
+3 DO LINE
+4 QUIT
LINE SET X=""
SET $PIECE(X,"-",IOM)="-"
WRITE !,X
+1 QUIT
CHKDIV ; Check the CDR has been generated for one Division for the month
+1 NEW ACKERR
SET ACKERR=0
+2 SET ACKDIV=""
FOR
SET ACKDIV=$ORDER(ACKDIV(ACKDIV))
if ACKDIV=""
QUIT
Begin DoDot:1
+3 IF '$$DIVCDR(ACKDA,ACKDIV)
Begin DoDot:2
+4 SET ACKERR=ACKERR+1
SET ACKERR(ACKERR)=ACKDIV
+5 KILL ACKDIV(ACKDIV)
End DoDot:2
End DoDot:1
+6 ;
+7 ; none left to be printed
+8 IF $ORDER(ACKDIV(""))=""
Begin DoDot:1
+9 WRITE !!,"The CDR has not been generated for "_$$XDAT^ACKQUTL(ACKM)
+10 WRITE " for any of the selected",!,"Divisions",!!
End DoDot:1
SET ACKEXIT=1
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
QUIT
+11 ;
+12 ; at least one error
+13 IF ACKERR
Begin DoDot:1
+14 WRITE !!,"The CDR has not been generated for "_$$XDAT^ACKQUTL(ACKM)
+15 WRITE " for the following Division"_$SELECT(ACKERR>1:"s",1:"")
+16 FOR I=1:1:ACKERR
WRITE !?5,$$GET1^DIQ(40.8,ACKERR(I)_",",.01,"E")
End DoDot:1
+17 ;
+18 ; now list the Divisions that will be printed
+19 WRITE !!,"The CDR for "_$$XDAT^ACKQUTL(ACKM)_" will now print for the following Division"
+20 WRITE $SELECT($ORDER(ACKDIV(""))=$ORDER(ACKDIV(""),-1):"",1:"s")
+21 SET ACKDIV=""
FOR
SET ACKDIV=$ORDER(ACKDIV(ACKDIV))
if ACKDIV=""
QUIT
Begin DoDot:1
+22 WRITE !?5,$$GET1^DIQ(40.8,ACKDIV_",",.01,"E")
End DoDot:1
+23 ;
+24 ; End
+25 QUIT
CHKSITE ; Check the CDR has been generated for the selected month
+1 IF '$$SITECDR(ACKDA)
Begin DoDot:1
+2 WRITE !!,"The CDR has not been generated for "_$$XDAT^ACKQUTL(ACKM)_".",!
+3 SET ACKEXIT=1
End DoDot:1
+4 QUIT
GETDT ; Select month for report.
+1 NEW DIR,X,Y
GDT1 KILL DIR
+1 SET DIR(0)="D^::APE"
SET DIR("A")="Select Month & Year"
+2 SET DIR("B")=$$XDAT^ACKQUTL($$LM(DT))
SET DIR("?")="^D HELP^%DTC"
+3 SET DIR("??")="^D DATHLP^ACKQCDRP"
+4 DO ^DIR
+5 IF Y?1"^"1.E
WRITE !,"Jumping not allowed.",!
GOTO GDT1
+6 if $DATA(DIRUT)
QUIT
+7 SET ACKM=$EXTRACT(Y,1,5)_"00"
+8 IF ACKM>DT
WRITE !,"Can't run Cost Distribution Report for future months!",!
GOTO GDT1
+9 QUIT
DATHLP ; Extended help - select month for CDR report.
+1 WRITE !?5,"Enter a date, in the past, for which you wish to"
+2 WRITE !?5,"print the Cost Distribution Report."
+3 QUIT
LM(X) ;Find month previous to X.
+1 NEW M,D,Y
SET M=$EXTRACT(X,4,5)
SET D=$EXTRACT(X,6,7)
SET Y=$EXTRACT(X,1,3)
SET M=M-1
+2 if M<1
SET M=12
SET Y=Y-1
if M<10
SET M="0"_M
+3 QUIT Y_M_"00"
DIVCDR(ACKDA,ACKDIV) ; check if CDR generated for ACKDA (month) and ACKDIV
+1 NEW ACKTGT,ACKMSG,ACKFRM
+2 DO LIST^DIC(509850.754,","_ACKDIV_","_ACKDA_",","","",1,.ACKFRM,"","","","","ACKTGT","ACKMSG")
+3 QUIT $PIECE(ACKTGT("DILIST",0),U,1)=1
SITECDR(ACKDA) ; check is CDR generated for ACKDA (month) for the site
+1 NEW ACKTGT,ACKMSG,ACKFRM
+2 DO LIST^DIC(509850.74,","_ACKDA_",","","",1,.ACKFRM,"","","","","ACKTGT","ACKMSG")
+3 QUIT $PIECE(ACKTGT("DILIST",0),U,1)=1
