ACHSVDF ; DSD/GTH - DOCUMENTS BY PROVIDER/VENDOR BY FY ; [ 05/16/2002 10:01 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**26**;JUN 11, 2001;Build 43
;3.1*26 NEW ROUTINE
;
A ;
W !!
S DIC="^AUTTVNDR("
S DIC(0)="AEZQM"
S DIC("A")="Enter Provider/Vendor: "
D ^DIC K DIC
I +Y<1 G EXIT
;
S ACHSVDOR=+Y,ACHSIO=IO
I '$D(^ACHSF(DUZ(2),"VB",ACHSVDOR)) W *7,!!,"This vendor has no CHS documents on file.",! W:$$DIR^XBDIR("E","Press <RETURN> To Continue....") "" G A
;
SELFY ; ----- Display FYs, ask FY.
;
D SB1^ACHSFU ;DISPLAY VALID FISCAL YEARS
F %=0:0 S %=$O(ACHSFYWK(DUZ(2),%)) Q:'% S ACHSMIN=$S('$D(ACHSMIN):%,1:ACHSMIN),ACHSMAX=%
S ACHSSFY=$$DIR^XBDIR("N^"_ACHSMIN_":"_ACHSMAX_":0","ENTER FISCAL YEAR",ACHSMAX,"","ENTER FISCAL YEAR WITH ALL FOUR DIGITS","^D SB1^ACHSFU",1)
Q:$D(DUOUT)!$D(DTOUT)
I '$D(ACHSFYWK(DUZ(2),ACHSSFY)) W !,"FY DOES NOT EXIST." G SELFY
;
B ;
W !!,"TYPE of service:"
S ACHS("A")=$P($G(^DD(9002080.01,3,0)),U,3)
F ACHS=1:1 S ACHS(ACHS)=$P(ACHS("A"),";",ACHS) Q:ACHS(ACHS)="" W ?20,$P(ACHS(ACHS),":")," ",$P(ACHS(ACHS),":",2),!
W !,"Select TYPE of service (1 - ",ACHS-1," 'A' = 'ALL') ALL // "
D READ^ACHSFU
G SELFY:$D(DUOUT)
I $G(ACHSQUIT) G EXIT
S:(Y="") Y="A"
G B3:Y="A"
I ($E(Y)="?")!(Y<1)!(Y>(ACHS-1)) W !!,"Enter an 'A' to view documents for all type of service,",!,"otherwise, enter a number from 1 to ",ACHS-1,".",! G B
B3 ;
K ACHSTYPE
S:Y="A" ACHSTYPE="ALL"
I '$D(ACHSTYPE) S ACHSTYPE=+Y
;
D ;
W !!,"Type of Report:"
W !!,"1 list only PAID documents"
W !,"2 list only OPEN documents"
W !,"3 list only CANCELLED documents"
W !,"4 list ALL documents"
W !,"5 print TOTALS ONLY (no specific documents)",!!
W "list ALL documents// "
D READ^ACHSFU
G B:$D(DUOUT)
I $G(ACHSQUIT) G EXIT
S:(Y="") Y=4
I ($E(Y)="?")!(+Y<1)!(+Y>5) W !!,*7,"Enter only '1' through '5'." G D
S ACHSRPT=+Y
SORT ;SORT BY PATIENT OR PO
G:ACHSRPT=5 DEV
S DIR(0)="S^1:Purchase Order;2:Patient",DIR("A")="Sort by",DIR("B")=2
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT) G EXIT
S ACHSSRT=Y
DEV ;
S %=$$PB^ACHS
I %=U!$D(DTOUT)!$D(DUOUT) G EXIT
I %="B" D VIEWR^XBLM("PRINT^ACHSVDF"),EN^XBVK("VALM"),EXIT Q
S %ZIS="OPQ"
D ^%ZIS
I POP D HOME^%ZIS G EXIT
G:'$D(IO("Q")) PRINT
K IO("Q")
I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
S ZTRTN="PRINT^ACHSVDF",ZTDESC="CHS VENDOR Document Summary, for Fiscal Year"_ACHSSFY_" for "_ACHSVDOR
F ACHS="ACHSSRT","ACHSVDOR","ACHSSFY","ACHSRPT","ACHSTYPE" S ZTSAVE(ACHS)=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
G EXIT
;
PRINT ;EP - TaskMan.
Q:'$D(^AUTTVNDR(ACHSVDOR))
D FC^ACHSUF
I $D(ACHSERR),ACHSERR=1 G KILL
S (ACHSDOC,ACHSOPEN,ACHSOPEN("$"),ACHSPD,ACHSPD("$"),ACHSCNX,ACHSCNX("$"))=0
S ACHST3=$$C^XBFUNC($S(ACHSRPT=1:"PAID documents only",ACHSRPT=2:"OPEN documents only",ACHSRPT=3:"CANCELLED documents only",1:""),80)
S ACHST1=$$C^XBFUNC($P(^AUTTVNDR(ACHSVDOR,0),U)_" EIN #: "_$P(^AUTTVNDR(ACHSVDOR,11),U),80)_"-"_$P(^AUTTVNDR(ACHSVDOR,11),U,2)
S ACHST2=$$C^XBFUNC("For Fiscal Year "_ACHSSFY,80)
D BRPT^ACHSFU,HDR
I ACHSRPT<5 S ACHSTOS=$P(^DD(9002080.01,3,0),U,3),ACHSSTS=$P(^DD(9002080.01,11,0),U,3)
DOC ;
S ACHSDOC=$O(^ACHSF(DUZ(2),"VB",ACHSVDOR,ACHSDOC))
I ACHSDOC="",ACHSRPT=5 D END Q
I ACHSDOC="" G DOC1
S ACHSDOC0=$G(^ACHSF(DUZ(2),"D",ACHSDOC,0))
I ACHSDOC0="" W !!,"NO DOCUMENT ZERO NODE FOR X-REF VB FOR FACILITY: "_DUZ(2)_" DOCUMENT IEN: "_ACHSDOC D KILL Q
G DOC:$P(ACHSDOC0,U,14)'=$E(ACHSSFY,4)
G DOC:(ACHSTYPE'="ALL")&(ACHSTYPE'=$P(ACHSDOC0,U,4))
I ACHSRPT<4 S C=$P(ACHSDOC0,U,12) G DOC:ACHSRPT=1&(C'=3),DOC:ACHSRPT=2&(C>2),DOC:ACHSRPT=3&(C'=4)
G RPT5:ACHSRPT=5
S ACHSTYP=$P(ACHSDOC0,U,3)
S X=$S(ACHSTYP=1:"* BLANKET",ACHSTYP=2:"* SPECIAL TRANS",ACHSTYP=0:$P(^DPT($P(^ACHSF(DUZ(2),"D",ACHSDOC,"T",1,0),U,3),0),U),1:"")
S ^TMP("ACHSVDF",$J,ACHSDOC)=X
S ^TMP("ACHSVDF",$J,"B",X,ACHSDOC)=""
G DOC
DOC1 ;
S ACHSDOC=0,ACHSPAT=0
I ACHSSRT=1 F S ACHSDOC=$O(^TMP("ACHSVDF",$J,ACHSDOC)) Q:ACHSDOC'?1N.N D DOC2 Q:$G(ACHSQUIT)
I ACHSSRT'=1 F S ACHSPAT=$O(^TMP("ACHSVDF",$J,"B",ACHSPAT)) Q:ACHSPAT="" D Q:$G(ACHSQUIT)
.S ACHSDOC=0
.F S ACHSDOC=$O(^TMP("ACHSVDF",$J,"B",ACHSPAT,ACHSDOC)) Q:ACHSDOC'?1N.N D DOC2 Q:$G(ACHSQUIT)
I $G(ACHSQUIT) G EXIT
D END Q
DOC2 ;
S ACHSDOC0=$G(^ACHSF(DUZ(2),"D",ACHSDOC,0))
W !,"DOC. #: ",$P(ACHSDOC0,U,14),"-",ACHSFC,"-",$P(ACHSDOC0,U)," ("
K Y
I $D(^ACHSF(DUZ(2),"D",ACHSDOC,3)),+$P(^(3),U)>0 S Y=+$P(^(3),U)
S:'$D(Y) Y=+$P(ACHSDOC0,U,2)
W $$FMTE^XLFDT(Y),")",?45,"SERVICE: ",$P($P(ACHSTOS,";",$P(ACHSDOC0,U,4)),":",2)
W !?2
S DFN=$P(^ACHSF(DUZ(2),"D",ACHSDOC,"T",1,0),U,3)
I +DFN,$D(^DPT(DFN)) W $P(^DPT(DFN,0),U)
I $P(ACHSDOC0,U,3) W $S($P(ACHSDOC0,U,3)=1:"* BLANKET",$P(ACHSDOC0,U,3)=2:"* SPECIAL TRANS",1:"")
RPT5 ;
W:ACHSRPT<5 ?45
I '$D(^ACHSF(DUZ(2),"D",ACHSDOC,"PA")) G P5
;
S ACHS("$")=$S($D(^ACHSF(DUZ(2),"D",ACHSDOC,"ZA")):+^ACHSF(DUZ(2),"D",ACHSDOC,"ZA"),1:+^ACHSF(DUZ(2),"D",ACHSDOC,"PA"))
I ACHSRPT<5 W "(PAID: " S X=ACHS("$"),X2="2$" D FMT^ACHS W ")"
S ACHSPD=ACHSPD+1,ACHSPD("$")=ACHSPD("$")+ACHS("$")
G P6
;
P5 ;
I $P(ACHSDOC0,U,12)]"",ACHSRPT<5 W "(",$P($P(ACHSSTS,";",$P(ACHSDOC0,U,12)+1),":",2),": "
S ACHS("$")=$S($D(^ACHSF(DUZ(2),"D",ACHSDOC,"ZA")):+^("ZA"),1:$P(ACHSDOC0,U,9))
I $P(ACHSDOC0,U,12)=4 S ACHS("$")=0,A(1)=$O(^ACHSF(DUZ(2),"D",ACHSDOC,"T",0)) F ACHS=0:0 Q:+A(1)=0 S ACHS("$")=+$P(^(A(1),0),U,4),A(1)=$O(^ACHSF(DUZ(2),"D",ACHSDOC,"T",A(1)))
I ACHSRPT<5 S X=ACHS("$"),X2="2$" D FMT^ACHS W ")"
I $P(ACHSDOC0,U,12)=4 S ACHSCNX=ACHSCNX+1,ACHSCNX("$")=ACHSCNX("$")+ACHS("$") G P6
I $P(ACHSDOC0,U,12)<4 S ACHSOPEN=ACHSOPEN+1,ACHSOPEN("$")=ACHSOPEN("$")+ACHS("$")
P6 ;
I ACHSRPT<5 W !,$$REPEAT^XLFSTR("-",79)
I ACHSRPT<5,IOST["C-",$Y>ACHSBM D RTRN^ACHS D:'(ACHSQUIT) HDR
I ACHSRPT=5 G DOC
Q
;
END ;
W !,"Total documents: ",ACHSPD+ACHSCNX+ACHSOPEN,!!
I ACHSPD W "TOTAL PAID DOCUMENTS:",$J(ACHSPD,12),?40,"TOTAL DOLLARS PAID: " S X=ACHSPD("$"),X2="2$",X3=16 D FMT^ACHS W !
I ACHSCNX W "TOTAL CANCELLED DOCUMENTS:",$J(ACHSCNX,7),?40,"TOTAL DOLLARS CANCELLED:" S X=ACHSCNX("$"),X2="2$",X3=16 D FMT^ACHS W !
I ACHSOPEN W "TOTAL OPEN DOCUMENTS:",$J(ACHSOPEN,12),?40,"TOTAL DOLLARS OPEN: " S X=ACHSOPEN("$"),X3=16 D FMT^ACHS W !
D RTRN^ACHS
W @IOF
KILL ;
K A,ACHSCNX,ACHSDOC0,ACHSDOC,ACHSOPEN,ACHSPD,ACHSSTS,ACHSTOS,ACHSTYPE,ACHSVDOR
K ACHSQUIT,ACHSPAT,ACHSSRT
D ERPT^ACHS
EXIT ;
K A,ACHS,ACHSIO,ACHSVDOR,ACHSBDT,DTOUT,DUOUT,ACHSEDT,ACHSRPT,ACHSTYPE,ZTSK,ACHSSFY,^TMP("ACHSVDF",$J)
K ACHSMAX,ACHSMIN,ACHSTYP,DFN
D ^%ZISC
Q
;
HDR ;
S ACHSPG=ACHSPG+1
W @IOF,!,$$REPEAT^XLFSTR("*",79)
W !,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,$$C^XBFUNC("PROVIDER-SPECIFIC CHS ACTIVITIES SUMMARY",80),!,ACHST1,!,ACHST2
W:ACHST3]"" !,ACHST3
W !,$$REPEAT^XLFSTR("*",79)
Q
;
ACHSVDF ; DSD/GTH - DOCUMENTS BY PROVIDER/VENDOR BY FY ; [ 05/16/2002 10:01 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**26**;JUN 11, 2001;Build 43
+2 ;3.1*26 NEW ROUTINE
+3 ;
A ;
+1 WRITE !!
+2 SET DIC="^AUTTVNDR("
+3 SET DIC(0)="AEZQM"
+4 SET DIC("A")="Enter Provider/Vendor: "
+5 DO ^DIC
KILL DIC
+6 IF +Y<1
GOTO EXIT
+7 ;
+8 SET ACHSVDOR=+Y
SET ACHSIO=IO
+9 IF '$DATA(^ACHSF(DUZ(2),"VB",ACHSVDOR))
WRITE *7,!!,"This vendor has no CHS documents on file.",!
IF $$DIR^XBDIR("E","Press <RETURN> To Continue....")
WRITE ""
GOTO A
+10 ;
SELFY ; ----- Display FYs, ask FY.
+1 ;
+2 ;DISPLAY VALID FISCAL YEARS
DO SB1^ACHSFU
+3 FOR %=0:0
SET %=$ORDER(ACHSFYWK(DUZ(2),%))
IF '%
QUIT
SET ACHSMIN=$SELECT('$DATA(ACHSMIN):%,1:ACHSMIN)
SET ACHSMAX=%
+4 SET ACHSSFY=$$DIR^XBDIR("N^"_ACHSMIN_":"_ACHSMAX_":0","ENTER FISCAL YEAR",ACHSMAX,"","ENTER FISCAL YEAR WITH ALL FOUR DIGITS","^D SB1^ACHSFU",1)
+5 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+6 IF '$DATA(ACHSFYWK(DUZ(2),ACHSSFY))
WRITE !,"FY DOES NOT EXIST."
GOTO SELFY
+7 ;
B ;
+1 WRITE !!,"TYPE of service:"
+2 SET ACHS("A")=$PIECE($GET(^DD(9002080.01,3,0)),U,3)
+3 FOR ACHS=1:1
SET ACHS(ACHS)=$PIECE(ACHS("A"),";",ACHS)
IF ACHS(ACHS)=""
QUIT
WRITE ?20,$PIECE(ACHS(ACHS),":")," ",$PIECE(ACHS(ACHS),":",2),!
+4 WRITE !,"Select TYPE of service (1 - ",ACHS-1," 'A' = 'ALL') ALL // "
+5 DO READ^ACHSFU
+6 IF $DATA(DUOUT)
GOTO SELFY
+7 IF $GET(ACHSQUIT)
GOTO EXIT
+8 IF (Y="")
SET Y="A"
+9 IF Y="A"
GOTO B3
+10 IF ($EXTRACT(Y)="?")!(Y<1)!(Y>(ACHS-1))
WRITE !!,"Enter an 'A' to view documents for all type of service,",!,"otherwise, enter a number from 1 to ",ACHS-1,".",!
GOTO B
B3 ;
+1 KILL ACHSTYPE
+2 IF Y="A"
SET ACHSTYPE="ALL"
+3 IF '$DATA(ACHSTYPE)
SET ACHSTYPE=+Y
+4 ;
D ;
+1 WRITE !!,"Type of Report:"
+2 WRITE !!,"1 list only PAID documents"
+3 WRITE !,"2 list only OPEN documents"
+4 WRITE !,"3 list only CANCELLED documents"
+5 WRITE !,"4 list ALL documents"
+6 WRITE !,"5 print TOTALS ONLY (no specific documents)",!!
+7 WRITE "list ALL documents// "
+8 DO READ^ACHSFU
+9 IF $DATA(DUOUT)
GOTO B
+10 IF $GET(ACHSQUIT)
GOTO EXIT
+11 IF (Y="")
SET Y=4
+12 IF ($EXTRACT(Y)="?")!(+Y<1)!(+Y>5)
WRITE !!,*7,"Enter only '1' through '5'."
GOTO D
+13 SET ACHSRPT=+Y
SORT ;SORT BY PATIENT OR PO
+1 IF ACHSRPT=5
GOTO DEV
+2 SET DIR(0)="S^1:Purchase Order;2:Patient"
SET DIR("A")="Sort by"
SET DIR("B")=2
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXIT
+5 SET ACHSSRT=Y
DEV ;
+1 SET %=$$PB^ACHS
+2 IF %=U!$DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
+3 IF %="B"
DO VIEWR^XBLM("PRINT^ACHSVDF")
DO EN^XBVK("VALM")
DO EXIT
QUIT
+4 SET %ZIS="OPQ"
+5 DO ^%ZIS
+6 IF POP
DO HOME^%ZIS
GOTO EXIT
+7 IF '$DATA(IO("Q"))
GOTO PRINT
+8 KILL IO("Q")
+9 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+10 SET ZTRTN="PRINT^ACHSVDF"
SET ZTDESC="CHS VENDOR Document Summary, for Fiscal Year"_ACHSSFY_" for "_ACHSVDOR
+11 FOR ACHS="ACHSSRT","ACHSVDOR","ACHSSFY","ACHSRPT","ACHSTYPE"
SET ZTSAVE(ACHS)=""
+12 DO ^%ZTLOAD
+13 IF '$DATA(ZTSK)
GOTO DEV
+14 GOTO EXIT
+15 ;
PRINT ;EP - TaskMan.
+1 IF '$DATA(^AUTTVNDR(ACHSVDOR))
QUIT
+2 DO FC^ACHSUF
+3 IF $DATA(ACHSERR)
IF ACHSERR=1
GOTO KILL
+4 SET (ACHSDOC,ACHSOPEN,ACHSOPEN("$"),ACHSPD,ACHSPD("$"),ACHSCNX,ACHSCNX("$"))=0
+5 SET ACHST3=$$C^XBFUNC($SELECT(ACHSRPT=1:"PAID documents only",ACHSRPT=2:"OPEN documents only",ACHSRPT=3:"CANCELLED documents only",1:""),80)
+6 SET ACHST1=$$C^XBFUNC($PIECE(^AUTTVNDR(ACHSVDOR,0),U)_" EIN #: "_$PIECE(^AUTTVNDR(ACHSVDOR,11),U),80)_"-"_$PIECE(^AUTTVNDR(ACHSVDOR,11),U,2)
+7 SET ACHST2=$$C^XBFUNC("For Fiscal Year "_ACHSSFY,80)
+8 DO BRPT^ACHSFU
DO HDR
+9 IF ACHSRPT<5
SET ACHSTOS=$PIECE(^DD(9002080.01,3,0),U,3)
SET ACHSSTS=$PIECE(^DD(9002080.01,11,0),U,3)
DOC ;
+1 SET ACHSDOC=$ORDER(^ACHSF(DUZ(2),"VB",ACHSVDOR,ACHSDOC))
+2 IF ACHSDOC=""
IF ACHSRPT=5
DO END
QUIT
+3 IF ACHSDOC=""
GOTO DOC1
+4 SET ACHSDOC0=$GET(^ACHSF(DUZ(2),"D",ACHSDOC,0))
+5 IF ACHSDOC0=""
WRITE !!,"NO DOCUMENT ZERO NODE FOR X-REF VB FOR FACILITY: "_DUZ(2)_" DOCUMENT IEN: "_ACHSDOC
DO KILL
QUIT
+6 IF $PIECE(ACHSDOC0,U,14)'=$EXTRACT(ACHSSFY,4)
GOTO DOC
+7 IF (ACHSTYPE'="ALL")&(ACHSTYPE'=$PIECE(ACHSDOC0,U,4))
GOTO DOC
+8 IF ACHSRPT<4
SET C=$PIECE(ACHSDOC0,U,12)
IF ACHSRPT=1&(C'=3)
GOTO DOC
IF ACHSRPT=2&(C>2)
GOTO DOC
IF ACHSRPT=3&(C'=4)
GOTO DOC
+9 IF ACHSRPT=5
GOTO RPT5
+10 SET ACHSTYP=$PIECE(ACHSDOC0,U,3)
+11 SET X=$SELECT(ACHSTYP=1:"* BLANKET",ACHSTYP=2:"* SPECIAL TRANS",ACHSTYP=0:$PIECE(^DPT($PIECE(^ACHSF(DUZ(2),"D",ACHSDOC,"T",1,0),U,3),0),U),1:"")
+12 SET ^TMP("ACHSVDF",$JOB,ACHSDOC)=X
+13 SET ^TMP("ACHSVDF",$JOB,"B",X,ACHSDOC)=""
+14 GOTO DOC
DOC1 ;
+1 SET ACHSDOC=0
SET ACHSPAT=0
+2 IF ACHSSRT=1
FOR
SET ACHSDOC=$ORDER(^TMP("ACHSVDF",$JOB,ACHSDOC))
IF ACHSDOC'?1N.N
QUIT
DO DOC2
IF $GET(ACHSQUIT)
QUIT
+3 IF ACHSSRT'=1
FOR
SET ACHSPAT=$ORDER(^TMP("ACHSVDF",$JOB,"B",ACHSPAT))
IF ACHSPAT=""
QUIT
Begin DoDot:1
+4 SET ACHSDOC=0
+5 FOR
SET ACHSDOC=$ORDER(^TMP("ACHSVDF",$JOB,"B",ACHSPAT,ACHSDOC))
IF ACHSDOC'?1N.N
QUIT
DO DOC2
IF $GET(ACHSQUIT)
QUIT
End DoDot:1
IF $GET(ACHSQUIT)
QUIT
+6 IF $GET(ACHSQUIT)
GOTO EXIT
+7 DO END
QUIT
DOC2 ;
+1 SET ACHSDOC0=$GET(^ACHSF(DUZ(2),"D",ACHSDOC,0))
+2 WRITE !,"DOC. #: ",$PIECE(ACHSDOC0,U,14),"-",ACHSFC,"-",$PIECE(ACHSDOC0,U)," ("
+3 KILL Y
+4 IF $DATA(^ACHSF(DUZ(2),"D",ACHSDOC,3))
IF +$PIECE(^(3),U)>0
SET Y=+$PIECE(^(3),U)
+5 IF '$DATA(Y)
SET Y=+$PIECE(ACHSDOC0,U,2)
+6 WRITE $$FMTE^XLFDT(Y),")",?45,"SERVICE: ",$PIECE($PIECE(ACHSTOS,";",$PIECE(ACHSDOC0,U,4)),":",2)
+7 WRITE !?2
+8 SET DFN=$PIECE(^ACHSF(DUZ(2),"D",ACHSDOC,"T",1,0),U,3)
+9 IF +DFN
IF $DATA(^DPT(DFN))
WRITE $PIECE(^DPT(DFN,0),U)
+10 IF $PIECE(ACHSDOC0,U,3)
WRITE $SELECT($PIECE(ACHSDOC0,U,3)=1:"* BLANKET",$PIECE(ACHSDOC0,U,3)=2:"* SPECIAL TRANS",1:"")
RPT5 ;
+1 IF ACHSRPT<5
WRITE ?45
+2 IF '$DATA(^ACHSF(DUZ(2),"D",ACHSDOC,"PA"))
GOTO P5
+3 ;
+4 SET ACHS("$")=$SELECT($DATA(^ACHSF(DUZ(2),"D",ACHSDOC,"ZA")):+^ACHSF(DUZ(2),"D",ACHSDOC,"ZA"),1:+^ACHSF(DUZ(2),"D",ACHSDOC,"PA"))
+5 IF ACHSRPT<5
WRITE "(PAID: "
SET X=ACHS("$")
SET X2="2$"
DO FMT^ACHS
WRITE ")"
+6 SET ACHSPD=ACHSPD+1
SET ACHSPD("$")=ACHSPD("$")+ACHS("$")
+7 GOTO P6
+8 ;
P5 ;
+1 IF $PIECE(ACHSDOC0,U,12)]""
IF ACHSRPT<5
WRITE "(",$PIECE($PIECE(ACHSSTS,";",$PIECE(ACHSDOC0,U,12)+1),":",2),": "
+2 SET ACHS("$")=$SELECT($DATA(^ACHSF(DUZ(2),"D",ACHSDOC,"ZA")):+^("ZA"),1:$PIECE(ACHSDOC0,U,9))
+3 IF $PIECE(ACHSDOC0,U,12)=4
SET ACHS("$")=0
SET A(1)=$ORDER(^ACHSF(DUZ(2),"D",ACHSDOC,"T",0))
FOR ACHS=0:0
IF +A(1)=0
QUIT
SET ACHS("$")=+$PIECE(^(A(1),0),U,4)
SET A(1)=$ORDER(^ACHSF(DUZ(2),"D",ACHSDOC,"T",A(1)))
+4 IF ACHSRPT<5
SET X=ACHS("$")
SET X2="2$"
DO FMT^ACHS
WRITE ")"
+5 IF $PIECE(ACHSDOC0,U,12)=4
SET ACHSCNX=ACHSCNX+1
SET ACHSCNX("$")=ACHSCNX("$")+ACHS("$")
GOTO P6
+6 IF $PIECE(ACHSDOC0,U,12)<4
SET ACHSOPEN=ACHSOPEN+1
SET ACHSOPEN("$")=ACHSOPEN("$")+ACHS("$")
P6 ;
+1 IF ACHSRPT<5
WRITE !,$$REPEAT^XLFSTR("-",79)
+2 IF ACHSRPT<5
IF IOST["C-"
IF $Y>ACHSBM
DO RTRN^ACHS
IF '(ACHSQUIT)
DO HDR
+3 IF ACHSRPT=5
GOTO DOC
+4 QUIT
+5 ;
END ;
+1 WRITE !,"Total documents: ",ACHSPD+ACHSCNX+ACHSOPEN,!!
+2 IF ACHSPD
WRITE "TOTAL PAID DOCUMENTS:",$JUSTIFY(ACHSPD,12),?40,"TOTAL DOLLARS PAID: "
SET X=ACHSPD("$")
SET X2="2$"
SET X3=16
DO FMT^ACHS
WRITE !
+3 IF ACHSCNX
WRITE "TOTAL CANCELLED DOCUMENTS:",$JUSTIFY(ACHSCNX,7),?40,"TOTAL DOLLARS CANCELLED:"
SET X=ACHSCNX("$")
SET X2="2$"
SET X3=16
DO FMT^ACHS
WRITE !
+4 IF ACHSOPEN
WRITE "TOTAL OPEN DOCUMENTS:",$JUSTIFY(ACHSOPEN,12),?40,"TOTAL DOLLARS OPEN: "
SET X=ACHSOPEN("$")
SET X3=16
DO FMT^ACHS
WRITE !
+5 DO RTRN^ACHS
+6 WRITE @IOF
KILL ;
+1 KILL A,ACHSCNX,ACHSDOC0,ACHSDOC,ACHSOPEN,ACHSPD,ACHSSTS,ACHSTOS,ACHSTYPE,ACHSVDOR
+2 KILL ACHSQUIT,ACHSPAT,ACHSSRT
+3 DO ERPT^ACHS
EXIT ;
+1 KILL A,ACHS,ACHSIO,ACHSVDOR,ACHSBDT,DTOUT,DUOUT,ACHSEDT,ACHSRPT,ACHSTYPE,ZTSK,ACHSSFY,^TMP("ACHSVDF",$JOB)
+2 KILL ACHSMAX,ACHSMIN,ACHSTYP,DFN
+3 DO ^%ZISC
+4 QUIT
+5 ;
HDR ;
+1 SET ACHSPG=ACHSPG+1
+2 WRITE @IOF,!,$$REPEAT^XLFSTR("*",79)
+3 WRITE !,ACHSUSR,?71,"Page",$JUSTIFY(ACHSPG,3),!,$$C^XBFUNC("PROVIDER-SPECIFIC CHS ACTIVITIES SUMMARY",80),!,ACHST1,!,ACHST2
+4 IF ACHST3]""
WRITE !,ACHST3
+5 WRITE !,$$REPEAT^XLFSTR("*",79)
+6 QUIT
+7 ;
