ACHSDSTL.m

ACHSDSTL ;IHS/OIT/FCJ - DOCUMENT STATUS REPORT BY FY; [ 02/09/2001  10:54 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**26**;JUN 11, 2001;Build 43

 ;3.1*26  IHS/OIT/FCJ NEW RTN FR A 1.6 VERSION

 ;

 ;

 W !!,$$C^XBFUNC("***   DOCUMENT STATUS REPORT FOR SPECIAL LOCAL PO'S  ***",80)

 W !!,$$C^XBFUNC("for  "_$P(^DIC(4,DUZ(2),0),"^"),80)

 S ACHSIO=IO

 D ^ACHSVAR,LINES^ACHSFU

BDT ; Enter beginning date.

 S ACHSBDT=$$DATE^ACHS("B","for Special Local PO's","ISSUE")

 G ENDQ:$D(DUOUT)!$D(DTOUT)!(ACHSBDT<1)

EDT ; Enter the ending date.

 S ACHSEDT=$$DATE^ACHS("E","for Special Local PO's","ISSUE")

 G BDT:$D(DUOUT)!(ACHSEDT<1),EDT:$$EBB^ACHS(ACHSBDT,ACHSEDT)

TYPE ;

 S TYPE=3     ;COMBINED OPEN,CLOSED, CANCELLED

TOT ;

 S TOTONLY=0

 W !!,"TYPE OF DATA ON REPORT: ",!!,"  1. TOTALS ONLY",!,"  2. DETAILED DOCUMENTS & TOTALS",!!,"  ENTER 1 or 2:  1//" D READ^ACHSFU I $D(DLOUT)!(Y="") S Y=1

 G ENDQ:$D(DTOUT)!$D(DFOUT),EDT:$D(DUOUT) I "12"[Y&(Y>0)&(Y<3) S TOTONLY=Y

 I (TOTONLY'=1)&(TOTONLY'=2) W *7,"  ??" G TOT

FY ;

 W !!,"Enter Fiscal Year (e.g. 2016): " D READ^ACHSFU

 G ENDQ:$D(DTOUT)!$D(DFOUT),TOT:$D(DUOUT)!$D(DLOUT)

 I Y'?4N W *7,"  ??" H 2 G FY

 I '$D(^ACHS(9,DUZ(2),"FY",Y)) W !!,*7,"NO DATA ON FILE FOR FY!!" H 2 G FY

 S TOTFYN=$E(Y,4) S TOTFY=$E(Y,3,4)

DEVICE ;

 W ! K IOP,%ZIS("B") S %ZIS="PQ" D ^%ZIS K %ZIS I IO="" W !,*7,"No device specified." S IOP=$I D ^%ZIS Q

 I $D(IO("Q"))#2,$E(IOST)'="P" W *7,!,"Please queue to printers only." K IO("Q") G DEVICE

 I $D(IO("Q")) K IO("Q") S ZTRTN="ST^ACHSDSTL1",ZTDESC="CHS Document Status - Special Local PO's, "_$E(ACHSBDT,2,7)_" to "_$E(ACHSEDT,2,7) F G="DUZ(2)","ACHSBDT","ACHSEDT","TYPE","TOTFY","TOTFYN","TOTONLY" S ZTSAVE(G)=""

 I  D ^%ZTLOAD G ENDQ

 I IO=$I G ST

 S IOP=IO D ^%ZIS I 'POP G ST

 W !,*7,"Device ",IO," busy." G DEVICE

ST ;

 D ^ACHSVAR,LINES^ACHSFU

 S ACHSPG=0,(TOTP,CNX,OPEN,TOTP("$"),CNX("$"),OPEN("$"))=0,ACHSLOC=$P(^DIC(4,DUZ(2),0),U),Y=ACHSBDT X ^DD("DD") S BDT=Y,Y=ACHSEDT X ^DD("DD") S EDT=Y

 S X="SPECIAL LOCAL DOCUMENT REPORT",X=$$C^XBFUNC(X_" IN FY "_TOTFY,80)

 S ACHST1=X,X=$$C^XBFUNC("For the period "_BDT_" through "_EDT,80) S ACHST2=X K BDT,EDT

 U IO D NOW^ACHS D HEAD S ACHSBDT=ACHSBDT-1 D BM^ACHS

A ; Main loop.

 S ACHSBDT=$O(^ACHSF(DUZ(2),"TB",ACHSBDT))

 G TOTAL:+ACHSBDT=0!(+ACHSBDT>ACHSEDT)

 S ACHSTYPE=""

B ;

 S ACHSTYPE=$O(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTYPE))

 G A:ACHSTYPE=""

 G B:ACHSTYPE'="I"

 S ACHSDIEN=0

C ;

 S ACHSDIEN=$O(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTYPE,ACHSDIEN))

 G B:+ACHSDIEN=0,C:'$D(^ACHSF(DUZ(2),"D",ACHSDIEN,0))

 G:$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),"^",3)'=2 C   ;TEST FOR SPECIAL LOCAL PO

 G C:$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,14)'=TOTFYN  ;TEST FOR FY

STAT ;

 S ACHSDOC1=^ACHSF(DUZ(2),"D",ACHSDIEN,0)

 S ACHSSTS=$S($P(ACHSDOC1,U,12)=3:"P",$P(ACHSDOC1,U,12)=4:"C",1:"OPEN")

 S A("DOC1")=$P(ACHSDOC1,U),A("VPTR")=$P(ACHSDOC1,U,8),A("DOC2")=$P(ACHSDOC1,U,14),A("$")=$P(ACHSDOC1,U,9),TOS=$P(ACHSDOC1,U,4),BLANKET=+$P(ACHSDOC1,U,3)

 ;

 I TOTONLY=1 G TOTONLY

 G A:A("VPTR")']"",A:'$D(^AUTTVNDR(A("VPTR"),0)) S A("VENDOR")=$P(^(0),U) S EIN="" S:$D(^(11)) EIN=$P(^(11),U)

 S A("FC")=$P(^AUTTLOC(DUZ(2),0),U,17),A=$P(^(0),U,4),A("PFX")=$P(^AUTTAREA(A,0),U,3),A("FC")=$E(A("FC"),2,3),A("DOC")=A("DOC2")_"-"_A("PFX")_A("FC")_"-"_A("DOC1")

 S A=$O(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTYPE,ACHSDIEN,0))

 I +A>0,$D(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",A,0))

 S ACHSNAME=$S($P(ACHSDOC1,U,3)=1:"* BLANKET",$P(ACHSDOC1,U,3)=2:"* SPECIAL TRANS",1:"")

D ;

 G C:'$D(ACHSNAME) S:$D(^ACHSF(DUZ(2),"D",ACHSDIEN,"PA")) A("$")=+^("PA") S:$D(^ACHSF(DUZ(2),"D",ACHSDIEN,"ZA")) A("$")=+^("ZA")

E ;

 G PRINT:ACHSSTS'="C" S A("$")=0,A(1)=0

E1 ;

 S A(1)=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",A(1))) G PRINT:+A(1)=0 S A("$")=+$P(^(A(1),0),U,4) G E1

PRINT ;

 S ACHSSTA=$S(ACHSSTS="P":"PAID",ACHSSTS="P":"CANCEL",1:"OPEN")

 I '$D(ZTSK),$Y>ACHSBM D RTRN^ACHS G:ACHSQUIT END  D HEAD

 W !,$E(ACHSNAME,1,24),?25,$E(A("VENDOR"),1,26),?52,$$FMTE^XLFDT(ACHSBDT,"2D"),?63,ACHSSTA

 G P1:"PC"'[ACHSSTS W $S(ACHSSTS="P":"PAID",1:"CANCEL")

 S X=A("$") D MONEY W ?79-$L(X),X G P2

P1 ;

 I +A("$")'=0 S X=A("$") D MONEY W ?79-$L(X),X

P2 ;

 W !,A("DOC"),?25,EIN I +TOS W ?52,$S(+TOS=1:"HOSPITAL",+TOS=2:"DENTAL",+TOS=3:"OUTPATIENT",1:"")

TOTONLY ;ENTRY POINT TO ONLY CALCULATE TOTALS FOR TOTAL ONLY PRINT

 I ACHSSTS="P" S TOTP=TOTP+1,TOTP("$")=TOTP("$")+A("$")

 I ACHSSTS="C" S CNX=CNX+1,CNX("$")=CNX("$")+A("$")

 I ACHSSTS="OPEN" S OPEN=OPEN+1,OPEN("$")=OPEN("$")+A("$")

 S ISSUE("YM")=$E(ACHSBDT,1,5)

 I '$D(TOPEN(ISSUE("YM"),"$")) S TOPEN(ISSUE("YM"),"$")=0,TOPEN(ISSUE("YM"),"DOC")=0

 S TOPEN(ISSUE("YM"),"$")=TOPEN(ISSUE("YM"),"$")+A("$")

 S TOPEN(ISSUE("YM"),"DOC")=TOPEN(ISSUE("YM"),"DOC")+1

 G C

TOTAL ;

 ;PRINT OUT EACH MONTH END TOTAL

 S YRMO=0

 W !!,?10,"Month Issued",?30,"# of Documents",?65,"Total Amount",!,ACHS("-")

 F  S YRMO=$O(TOPEN(YRMO)) Q:+YRMO=0  D ENDMOPT

 W !!,ACHS("-"),!

TOTTYP ;PRINT DOCUMENT TOTALS BY TYPE

 I TOTP>0,TYPE>2 D

 .W "TOTAL PAID DOCUMENTS: ",?32-$L(TOTP),TOTP,?40,"TOTAL DOLLARS PAID: " S X=TOTP("$") D MONEY W ?79-$L(X),X,!

 I CNX>0,TYPE=3 D

 .W "TOTAL CANCELLED DOCUMENTS: ",?32-$L(CNX),CNX,?40,"TOTAL DOLLARS CANCELLED: " S X=CNX("$") D MONEY W ?79-$L(X),X,!

 I OPEN>0,TYPE=3 D

 .W "TOTAL OPEN DOCUMENTS: ",?32-$L(OPEN),OPEN,?40,"TOTAL DOLLARS: " S X=OPEN("$") D MONEY W ?79-$L(X),X,!

TOTDOC ;

 W !,ACHS("-"),!

 S TOTDOC=0,TOT("$")=0

 S TOTDOC=TOTP+CNX+OPEN,TOT("$")=TOTP("$")+CNX("$")+OPEN("$")

 W "TOTAL DOCUMENTS: ",?32-$L(TOTDOC),TOTDOC,?40,"TOTAL DOLLARS: " S X=TOT("$") D MONEY W ?79-$L(X),X

 W !

 D RTRN^ACHS W @IOF

END ;

 D ERPT^ACHS

 K ZTSK,A,AG,AGT,ACHS,ACHSBDT,CNX,ACHSEDT,EIN,ACHSLOC,OPEN,ACHSNAME,ACHSTYPE,ACHSSSN,ACHSQUIT

 K TOS,TOTP,TYPE,X,X2,Y,Z,BLANKET,TOPEN,K,YRMO,TOT,TOTDOC,TOTFY,TOTFYN,TOTONLY,ACHSSTA

 Q

ENDQ ;

 K ACHSIO,ACHSBDT,DTOUT,DQOUT,DLOUT,DUOUT,DFOUT,ACHSEDT,X,Y

 Q

HEAD ;HEADING FOR TOTAL ONLY REPORT

 S ACHSPG=ACHSPG+1,ACHS("LINE")="=" W @IOF,!!?20,"***  CONTRACT HEALTH CARE SYSTEM  ***",!!,ACHSTIME,?80-$L(ACHSLOC)\2,ACHSLOC,?73,"page ",ACHSPG,!?29,"DOCUMENT STATUS REPORT"

 I $D(ZTSK) W ?77-$L(ZTSK),"(",ZTSK,")"

 W !!,ACHST1,!,ACHST2

 I TOTONLY=2 D

 .W !!,"Patient Name",?25,"Provider of Service",?52,"Trans Dt",?64,"Status",?73,"Amount",!,"Document #",?25,"EIN Number",?52,"Type"

 W !,ACHS("-"),!

 Q

ENDMOPT ;PRINT OUT EACH MONTH TOTALS

 S Y=YRMO_"00" X ^DD("DD") W !?13,Y

 W ?35,TOPEN(YRMO,"DOC")

 S X=TOPEN(YRMO,"$") D MONEY W ?79-$L(X),X

 Q

MONEY ;

 S X2=2 D COMMA^%DTC F Z=1:1 Q:$E(X)'=" "  S X=$E(X,2,99)

 F Z=1:1 Q:$E(X,$L(X))'=" "  S X=$E(X,1,$L(X)-1)

 Q

 ;

ACHSDSTL  ;IHS/OIT/FCJ - DOCUMENT STATUS REPORT BY FY; [ 02/09/2001  10:54 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**26**;JUN 11, 2001;Build 43

 +2       ;3.1*26  IHS/OIT/FCJ NEW RTN FR A 1.6 VERSION

 +3       ;

 +4       ;

 +5        WRITE !!,$$C^XBFUNC("***   DOCUMENT STATUS REPORT FOR SPECIAL LOCAL PO'S  ***",80)

 +6        WRITE !!,$$C^XBFUNC("for  "_$PIECE(^DIC(4,DUZ(2),0),"^"),80)

 +7        SET ACHSIO=IO

 +8        DO ^ACHSVAR

           DO LINES^ACHSFU

BDT       ; Enter beginning date.

 +1        SET ACHSBDT=$$DATE^ACHS("B","for Special Local PO's","ISSUE")

 +2        IF $DATA(DUOUT)!$DATA(DTOUT)!(ACHSBDT<1)

               GOTO ENDQ

EDT       ; Enter the ending date.

 +1        SET ACHSEDT=$$DATE^ACHS("E","for Special Local PO's","ISSUE")

 +2        IF $DATA(DUOUT)!(ACHSEDT<1)

               GOTO BDT

           IF $$EBB^ACHS(ACHSBDT,ACHSEDT)

               GOTO EDT

TYPE      ;

 +1       ;COMBINED OPEN,CLOSED, CANCELLED

           SET TYPE=3

TOT       ;

 +1        SET TOTONLY=0

 +2        WRITE !!,"TYPE OF DATA ON REPORT: ",!!,"  1. TOTALS ONLY",!,"  2. DETAILED DOCUMENTS & TOTALS",!!,"  ENTER 1 or 2:  1//"

           DO READ^ACHSFU

           IF $DATA(DLOUT)!(Y="")

               SET Y=1

 +3        IF $DATA(DTOUT)!$DATA(DFOUT)

               GOTO ENDQ

           IF $DATA(DUOUT)

               GOTO EDT

           IF "12"[Y&(Y>0)&(Y<3)

               SET TOTONLY=Y

 +4        IF (TOTONLY'=1)&(TOTONLY'=2)

               WRITE *7,"  ??"

               GOTO TOT

FY        ;

 +1        WRITE !!,"Enter Fiscal Year (e.g. 2016): "

           DO READ^ACHSFU

 +2        IF $DATA(DTOUT)!$DATA(DFOUT)

               GOTO ENDQ

           IF $DATA(DUOUT)!$DATA(DLOUT)

               GOTO TOT

 +3        IF Y'?4N

               WRITE *7,"  ??"

               HANG 2

               GOTO FY

 +4        IF '$DATA(^ACHS(9,DUZ(2),"FY",Y))

               WRITE !!,*7,"NO DATA ON FILE FOR FY!!"

               HANG 2

               GOTO FY

 +5        SET TOTFYN=$EXTRACT(Y,4)

           SET TOTFY=$EXTRACT(Y,3,4)

DEVICE    ;

 +1        WRITE !

           KILL IOP,%ZIS("B")

           SET %ZIS="PQ"

           DO ^%ZIS

           KILL %ZIS

           IF IO=""

               WRITE !,*7,"No device specified."

               SET IOP=$IO

               DO ^%ZIS

               QUIT 

 +2        IF $DATA(IO("Q"))#2

               IF $EXTRACT(IOST)'="P"

                   WRITE *7,!,"Please queue to printers only."

                   KILL IO("Q")

                   GOTO DEVICE

 +3        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTRTN="ST^ACHSDSTL1"

               SET ZTDESC="CHS Document Status - Special Local PO's, "_$EXTRACT(ACHSBDT,2,7)_" to "_$EXTRACT(ACHSEDT,2,7)

               FOR G="DUZ(2)","ACHSBDT","ACHSEDT","TYPE","TOTFY","TOTFYN","TOTONLY"

                   SET ZTSAVE(G)=""

 +4       IF $TEST

               DO ^%ZTLOAD

               GOTO ENDQ

 +5        IF IO=$IO

               GOTO ST

 +6        SET IOP=IO

           DO ^%ZIS

           IF 'POP

               GOTO ST

 +7        WRITE !,*7,"Device ",IO," busy."

           GOTO DEVICE

ST        ;

 +1        DO ^ACHSVAR

           DO LINES^ACHSFU

 +2        SET ACHSPG=0

           SET (TOTP,CNX,OPEN,TOTP("$"),CNX("$"),OPEN("$"))=0

           SET ACHSLOC=$PIECE(^DIC(4,DUZ(2),0),U)

           SET Y=ACHSBDT

           XECUTE ^DD("DD")

           SET BDT=Y

           SET Y=ACHSEDT

           XECUTE ^DD("DD")

           SET EDT=Y

 +3        SET X="SPECIAL LOCAL DOCUMENT REPORT"

           SET X=$$C^XBFUNC(X_" IN FY "_TOTFY,80)

 +4        SET ACHST1=X

           SET X=$$C^XBFUNC("For the period "_BDT_" through "_EDT,80)

           SET ACHST2=X

           KILL BDT,EDT

 +5        USE IO

           DO NOW^ACHS

           DO HEAD

           SET ACHSBDT=ACHSBDT-1

           DO BM^ACHS

A         ; Main loop.

 +1        SET ACHSBDT=$ORDER(^ACHSF(DUZ(2),"TB",ACHSBDT))

 +2        IF +ACHSBDT=0!(+ACHSBDT>ACHSEDT)

               GOTO TOTAL

 +3        SET ACHSTYPE=""

B         ;

 +1        SET ACHSTYPE=$ORDER(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTYPE))

 +2        IF ACHSTYPE=""

               GOTO A

 +3        IF ACHSTYPE'="I"

               GOTO B

 +4        SET ACHSDIEN=0

C         ;

 +1        SET ACHSDIEN=$ORDER(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTYPE,ACHSDIEN))

 +2        IF +ACHSDIEN=0

               GOTO B

           IF '$DATA(^ACHSF(DUZ(2),"D",ACHSDIEN,0))

               GOTO C

 +3       ;TEST FOR SPECIAL LOCAL PO

           IF $PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,0),"^",3)'=2

               GOTO C

 +4       ;TEST FOR FY

           IF $PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,14)'=TOTFYN

               GOTO C

STAT      ;

 +1        SET ACHSDOC1=^ACHSF(DUZ(2),"D",ACHSDIEN,0)

 +2        SET ACHSSTS=$SELECT($PIECE(ACHSDOC1,U,12)=3:"P",$PIECE(ACHSDOC1,U,12)=4:"C",1:"OPEN")

 +3        SET A("DOC1")=$PIECE(ACHSDOC1,U)

           SET A("VPTR")=$PIECE(ACHSDOC1,U,8)

           SET A("DOC2")=$PIECE(ACHSDOC1,U,14)

           SET A("$")=$PIECE(ACHSDOC1,U,9)

           SET TOS=$PIECE(ACHSDOC1,U,4)

           SET BLANKET=+$PIECE(ACHSDOC1,U,3)

 +4       ;

 +5        IF TOTONLY=1

               GOTO TOTONLY

 +6        IF A("VPTR")']""

               GOTO A

           IF '$DATA(^AUTTVNDR(A("VPTR"),0))

               GOTO A

           SET A("VENDOR")=$PIECE(^(0),U)

           SET EIN=""

           IF $DATA(^(11))

               SET EIN=$PIECE(^(11),U)

 +7        SET A("FC")=$PIECE(^AUTTLOC(DUZ(2),0),U,17)

           SET A=$PIECE(^(0),U,4)

           SET A("PFX")=$PIECE(^AUTTAREA(A,0),U,3)

           SET A("FC")=$EXTRACT(A("FC"),2,3)

           SET A("DOC")=A("DOC2")_"-"_A("PFX")_A("FC")_"-"_A("DOC1")

 +8        SET A=$ORDER(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTYPE,ACHSDIEN,0))

 +9        IF +A>0

               IF $DATA(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",A,0))

 +10       SET ACHSNAME=$SELECT($PIECE(ACHSDOC1,U,3)=1:"* BLANKET",$PIECE(ACHSDOC1,U,3)=2:"* SPECIAL TRANS",1:"")

D         ;

 +1        IF '$DATA(ACHSNAME)

               GOTO C

           IF $DATA(^ACHSF(DUZ(2),"D",ACHSDIEN,"PA"))

               SET A("$")=+^("PA")

           IF $DATA(^ACHSF(DUZ(2),"D",ACHSDIEN,"ZA"))

               SET A("$")=+^("ZA")

E         ;

 +1        IF ACHSSTS'="C"

               GOTO PRINT

           SET A("$")=0

           SET A(1)=0

E1        ;

 +1        SET A(1)=$ORDER(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",A(1)))

           IF +A(1)=0

               GOTO PRINT

           SET A("$")=+$PIECE(^(A(1),0),U,4)

           GOTO E1

PRINT     ;

 +1        SET ACHSSTA=$SELECT(ACHSSTS="P":"PAID",ACHSSTS="P":"CANCEL",1:"OPEN")

 +2        IF '$DATA(ZTSK)

               IF $Y>ACHSBM

                   DO RTRN^ACHS

                   IF ACHSQUIT

                       GOTO END

                   DO HEAD

 +3        WRITE !,$EXTRACT(ACHSNAME,1,24),?25,$EXTRACT(A("VENDOR"),1,26),?52,$$FMTE^XLFDT(ACHSBDT,"2D"),?63,ACHSSTA

 +4        IF "PC"'[ACHSSTS

               GOTO P1

           WRITE $SELECT(ACHSSTS="P":"PAID",1:"CANCEL")

 +5        SET X=A("$")

           DO MONEY

           WRITE ?79-$LENGTH(X),X

           GOTO P2

P1        ;

 +1        IF +A("$")'=0

               SET X=A("$")

               DO MONEY

               WRITE ?79-$LENGTH(X),X

P2        ;

 +1        WRITE !,A("DOC"),?25,EIN

           IF +TOS

               WRITE ?52,$SELECT(+TOS=1:"HOSPITAL",+TOS=2:"DENTAL",+TOS=3:"OUTPATIENT",1:"")

TOTONLY   ;ENTRY POINT TO ONLY CALCULATE TOTALS FOR TOTAL ONLY PRINT

 +1        IF ACHSSTS="P"

               SET TOTP=TOTP+1

               SET TOTP("$")=TOTP("$")+A("$")

 +2        IF ACHSSTS="C"

               SET CNX=CNX+1

               SET CNX("$")=CNX("$")+A("$")

 +3        IF ACHSSTS="OPEN"

               SET OPEN=OPEN+1

               SET OPEN("$")=OPEN("$")+A("$")

 +4        SET ISSUE("YM")=$EXTRACT(ACHSBDT,1,5)

 +5        IF '$DATA(TOPEN(ISSUE("YM"),"$"))

               SET TOPEN(ISSUE("YM"),"$")=0

               SET TOPEN(ISSUE("YM"),"DOC")=0

 +6        SET TOPEN(ISSUE("YM"),"$")=TOPEN(ISSUE("YM"),"$")+A("$")

 +7        SET TOPEN(ISSUE("YM"),"DOCHSDSTL_source.html#xC">C")=TOPEN(ISSUE("YM"),"DOCHSDSTL_source.html#xC">C")+1

 +8        GOTO C

TOTAL     ;

 +1       ;PRINT OUT EACH MONTH END TOTAL

 +2        SET YRMO=0

 +3        WRITE !!,?10,"Month Issued",?30,"# of Documents",?65,"Total Amount",!,ACHS("-")

 +4        FOR 

               SET YRMO=$ORDER(TOPEN(YRMO))

               IF +YRMO=0

                   QUIT 

               DO ENDMOPT

 +5        WRITE !!,ACHS("-"),!

TOTTYP    ;PRINT DOCUMENT TOTALS BY TYPE

 +1        IF TOTP>0

               IF TYPE>2

                   Begin DoDot:1

 +2                    WRITE "TOTAL PAID DOCUMENTS: ",?32-$LENGTH(TOTP),TOTP,?40,"TOTAL DOLLARS PAID: "

                       SET X=TOTP("$")

                       DO MONEY

                       WRITE ?79-$LENGTH(X),X,!

                   End DoDot:1

 +3        IF CNX>0

               IF TYPE=3

                   Begin DoDot:1

 +4                    WRITE "TOTAL CANCELLED DOCUMENTS: ",?32-$LENGTH(CNX),CNX,?40,"TOTAL DOLLARS CANCELLED: "

                       SET X=CNX("$")

                       DO MONEY

                       WRITE ?79-$LENGTH(X),X,!

                   End DoDot:1

 +5        IF OPEN>0

               IF TYPE=3

                   Begin DoDot:1

 +6                    WRITE "TOTAL OPEN DOCUMENTS: ",?32-$LENGTH(OPEN),OPEN,?40,"TOTAL DOLLARS: "

                       SET X=OPEN("$")

                       DO MONEY

                       WRITE ?79-$LENGTH(X),X,!

                   End DoDot:1

TOTDOC    ;

 +1        WRITE !,ACHS("-"),!

 +2        SET TOTDOC=0

           SET TOT("$")=0

 +3        SET TOTDOC=TOTP+CNX+OPEN

           SET TOT("$")=TOTP("$")+CNX("$")+OPEN("$")

 +4        WRITE "TOTAL DOCHSDSTL_source.html#xC">CUMENTS: ",?32-$LENGTH(TOTDOCHSDSTL_source.html#xC">C),TOTDOCHSDSTL_source.html#xC">C,?40,"TOTAL DOLLARS: "

           SET X=TOT("$")

           DO MONEY

           WRITE ?79-$LENGTH(X),X

 +5        WRITE !

 +6        DO RTRN^ACHS

           WRITE @IOF

END       ;

 +1        DO ERPT^ACHS

 +2        KILL ZTSK,A,AG,AGT,ACHS,ACHSBDT,CNX,ACHSEDT,EIN,ACHSLOC,OPEN,ACHSNAME,ACHSTYPE,ACHSSSN,ACHSQUIT

 +3        KILL TOS,TOTP,TYPE,X,X2,Y,Z,BLANKET,TOPEN,K,YRMO,TOT,TOTDOC,TOTFY,TOTFYN,TOTONLY,ACHSSTA

 +4        QUIT 

ENDQ      ;

 +1        KILL ACHSIO,ACHSBDT,DTOUT,DQOUT,DLOUT,DUOUT,DFOUT,ACHSEDT,X,Y

 +2        QUIT 

HEAD      ;HEADING FOR TOTAL ONLY REPORT

 +1        SET ACHSPG=ACHSPG+1

           SET ACHS("LINE")="="

           WRITE @IOF,!!?20,"***  CONTRACT HEALTH CARE SYSTEM  ***",!!,ACHSTIME,?80-$LENGTH(ACHSLOC)\2,ACHSLOC,?73,"page ",ACHSPG,!?29,"DOCUMENT STATUS REPORT"

 +2        IF $DATA(ZTSK)

               WRITE ?77-$LENGTH(ZTSK),"(",ZTSK,")"

 +3        WRITE !!,ACHST1,!,ACHST2

 +4        IF TOTONLY=2

               Begin DoDot:1

 +5                WRITE !!,"Patient Name",?25,"Provider of Service",?52,"Trans Dt",?64,"Status",?73,"Amount",!,"Document #",?25,"EIN Number",?52,"Type"

               End DoDot:1

 +6        WRITE !,ACHS("-"),!

 +7        QUIT 

ENDMOPT   ;PRINT OUT EACH MONTH TOTALS

 +1        SET Y=YRMO_"00"

           XECUTE ^DD("DD")

           WRITE !?13,Y

 +2        WRITE ?35,TOPEN(YRMO,"DOC")

 +3        SET X=TOPEN(YRMO,"$")

           DO MONEY

           WRITE ?79-$LENGTH(X),X

 +4        QUIT 

MONEY     ;

 +1        SET X2=2

           DO COMMA^%DTC

           FOR Z=1:1

               IF $EXTRACT(X)'=" "

                   QUIT 

               SET X=$EXTRACT(X,2,99)

 +2        FOR Z=1:1

               IF $EXTRACT(X,$LENGTH(X))'=" "

                   QUIT 

               SET X=$EXTRACT(X,1,$LENGTH(X)-1)

 +3        QUIT 

 +4       ;