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 ;
