Routine: ACHSDSTR1

ACHSDSTR1 ;IHS/OIT/FCJ;RTN 2 OF 2 - 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

ST ;

 D ^ACHSVAR,LINES^ACHSFU K ^TMP($J)

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

 S X=$S(TYPE=1:"OPEN DOCUMENTS",TYPE=2:"CLOSED DOCUMENTS",1:"OPEN AND CLOSED DOCUMENTS"),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=BDATE-1

A S ACHSBDT=$O(^ACHSF(DUZ(2),"TB",ACHSBDT)) G TOTAL:+ACHSBDT=0!(+ACHSBDT>EDATE) S ACHSTYPE=""

B S ACHSTYPE=$O(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTYPE)) G A:ACHSTYPE="",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)),C:$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,14)'=TOTFYN S A("X")=$P(^(0),U,12)

TYPE ;

 S STATUS=$S(A("X")=3:"P",A("X")=4:"C",1:"OPEN")

 I TYPE=1,"PC"[STATUS G C

 I TYPE=2,"PC"'[STATUS G C

 S A("DOC1")=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U),A("VPTR")=$P(^(0),U,8),A("DOC2")=$P(^(0),U,14),A("$")=$P(^(0),U,9),TOS=$P(^(0),U,4),BLANKET=+$P(^(0),U,3)

 S ACHSOCC="" I $P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,0)),U,7) S ACHSOCC=$P($G(^ACHS(3,DUZ(2),1,$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,7),0)),U,1)	;for object class

 S ACHSFDT="" I $P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,3)),U) S ACHSFDT=$$FMTE^XLFDT($P(^ACHSF(DUZ(2),"D",ACHSDIEN,3),U),"2D")      ;for authorized begin date

 S ACHSHRN="",ACHSHRN=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,21)		;for chart number

 S ACHSCLRK="" I $P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,0)),U,18) S ACHSCLRK=$P($G(^VA(200,$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,18),0)),U,2)

 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 ACHSNAME="",ACHSSSN="",A=$O(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTYPE,ACHSDIEN,0))

 I +A>0,$D(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",A,0)) S A("DFN")=$P(^(0),U,3) I +A("DFN")>0,$D(^DPT(A("DFN"),0)) S ACHSNAME=$P(^(0),U),ACHSSSN=$P($G(^DPT(A("DFN"),0)),U,9)

 I '$D(ACHSNAME),BLANKET S ACHSNAME=$S(BLANKET=1:"* BLANKET",1:"* SPECIAL TRANS")

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:STATUS'="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(STATUS="P":"PAID",STATUS="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,$S(ACHSRTYP=1:ACHSOCC,1:ACHSSTA)

 S:ACHSFIL ^TMP($J,"ACHSDSTR",ACHSDIEN)=ACHSNAME_U_A("VENDOR")_U_$$FMTE^XLFDT(ACHSBDT,"2D")_U_ACHSOCC

 G P1:"PC"'[STATUS

 S X=A("$") D MONEY W ?79-$L(X),X S:ACHSFIL ^TMP($J,"ACHSDSTR",ACHSDIEN)=^TMP($J,"ACHSDSTR",ACHSDIEN)_U_X G P2

P1 ;

 I +A("$")'=0 S X=A("$") D MONEY W ?79-$L(X),X S:ACHSFIL ^TMP($J,"ACHSDSTR",ACHSDIEN)=^TMP($J,"ACHSDSTR",ACHSDIEN)_U_X

P2 ;

 I ACHSRTYP=1 W !,A("DOC"),"(",ACHSCLRK,")",?25,ACHSHRN,?35,$E(ACHSSSN,6,9),?52,ACHSFDT I +TOS W ?63,$S(+TOS=1:"43",+TOS=2:"57",+TOS=3:"64",1:"")

 S:ACHSFIL ^TMP($J,"ACHSDSTR",ACHSDIEN)=^TMP($J,"ACHSDSTR",ACHSDIEN)_U_$S(+TOS=1:"43",+TOS=2:"57",+TOS=3:"64",1:"")_U_A("DOC")_"("_ACHSCLRK_")"_U_ACHSHRN_U_$E(ACHSSSN,6,9)_U_ACHSFDT_U

 I ACHSRTYP=2 W !,A("DOC"),"(",ACHSCLRK,")",?25,EIN,?52,$E(ACHSSSN,6,9) I +TOS W ?63,$S(+TOS=1:"43",+TOS=2:"57",+TOS=3:"64",1:"")

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

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

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

 I STATUS="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("-")

 S:ACHSFIL ^TMP($J,"ACHSDSTR","M")="Month Issued"_U_"# of Documents"_U_"Total Amount"

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

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

TOTTYP ;PRINT DOCUMENT TOTALS BY TYPE

 I TOTP>0,TYPE'=1 D

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

 .S:ACHSFIL ^TMP($J,"ACHSDSTR","TOTP")="TOTAL PAID DOCUMENTS: "_TOTP_U_"TOTAL DOLLARS PAID: "_X

 I CNX>0,TYPE'=1 D

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

 .S:ACHSFIL ^TMP($J,"ACHSDSTR","TOTC")="TOTAL CANCELLED DOCUMENTS: "_CNX_U_"TOTAL DOLLARS CANCELLED: "_X

 I OPEN>0,TYPE'=2 D

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

 .S:ACHSFIL ^TMP($J,"ACHSDSTR","TOTO")="TOTAL OPEN DOCUMENTS: "_OPEN_U_"TOTAL DOLLARS: "_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

 S:ACHSFIL ^TMP($J,"ACHSDSTR","TOTX")="TOTAL DOCUMENTS: "_TOTDOC_U_"TOTAL DOLLARS: "_X

W !

 K ACHSHAT D RTRN^ACHS W @IOF

END ;

 D:ACHSFIL FILSAV

 D ERPT^ACHS

 K ZTSK,A,AG,AGT,ACHS,ACHSHAT,BDATE,CNX,EDATE,EIN,ACHSLOC,OPEN,ACHSNAME,ACHSHRN,ACHSTYPE,ACHSSSN,ACHSOCC,ACHSQUIT,ACHSCLRK

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

 K ^TMP($J,"ACHSDSTR")

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,"Issue date",?63,$S(ACHSRTYP=1:"OCC",1:"Status"),?73,"Amount"

 .I ACHSRTYP=1 W !,"Document #/(Clerk)",?25,"Chart#",?35,"Last 4SSN",?52,"Auth Date",?63,"Type"

 .E  W !,"Document #/(Clerk)",?25,"EIN Number",?52,"Last 4SSN",?63,"Type"

 W !,ACHS("-"),!

 I ACHSFIL D

 .S ^TMP($J,"ACHSDSTR",1)="***  CONTRACT HEALTH CARE SYSTEM  ***"

 .S ^TMP($J,"ACHSDSTR",2)=ACHSTIME

 .S ^TMP($J,"ACHSDSTR",3)=ACHSLOC

 .S ^TMP($J,"ACHSDSTR",4)="DOCUMENT STATUS REPORT"

 .S ^TMP($J,"ACHSDSTR",5)=ACHST1

 .S ^TMP($J,"ACHSDSTR",6)=ACHST2

 .S:TOTONLY=1 ^TMP($J,"ACHSDSTR",7)="Month Issued"_U_"# of Documents"_U_"Total Amount"

 .S:TOTONLY=2 ^TMP($J,"ACHSDSTR",7)="Patient Name"_U_"Provider of Service"_U_"Issue date"_U_"OCC"_U_"Amount"_U_"Type"_U_"Document #/(Clerk)"_U_"Chart#"_U_"Last 4SSN"_U_"Auth Date"

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

 S:ACHSFIL ^TMP($J,"ACHSDSTR","M"_YRMO)=Y_U_TOPEN(YRMO,"DOC")_U_X

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)

FILSAV ;SAVE FILE

 N XBFN,XBE,XBJ,XBUF,XBQ,XBMED,XBFLT,XBS1,XBIO,XBF,XBGL

 S X=$E(DT,4,7)_$E(DT,2,3)

 D NOW^%DTC S X=(%I(3)+1700)_$E(%,4,7)_"_"_$P(%,".",2)

 S:$L(X)'=15 X=X_0

 S X1=$$ASF^ACHS(DUZ(2)),XBE=$J

 S XBFN="CHS-DOCUMENT-STATUS-"_X1_"."_X

 S XBQ="N",XBMED="F",XBFLT=1

 S XBUF=$$PARM^ACHS(1,5)

 I XBUF="" S XBUF=$P(^AUTTSITE(1,1),U,2)

 S XBS1="ACHS REPORTS"

 S XBIO=51,XBF=$J,XBGL="^TMP(" D ^ZIBGSVEM

 ;S XBGL="TMP("_$J_",""ACHSDSTR"","D ^XBGSAVE

ACHSDSTR1.m