Routine: ACHSDPVO2

ACHSDPVO ; IHS/OIT/FCJ - PROVIDER ON FILE REPORT-SPECIFIC VENDOR ;

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

 ;ORIGNAL RTN IS PROVIDER ON FILE DENIAL REPORT

 ;THE REPORT WAS MODIFIED TO PRINT PATIENT INFORMATION, SPECIFIC VENDOR

 ;AND DENIAL OPTIONS

GO ;

 S ACHDBDT=$$DATE^ACHS("B","PROVIDER (On File)")

 G END:ACHDBDT<1

 S ACHDEDT=$$DATE^ACHS("E","PROVIDER (On File)")

 G GO:ACHDEDT<1

SELV ;

 ; all or select one vendor to run

 S ACHDSELV=$$DIR^XBDIR("S^1:ALL Vendors;2:One Vendor only","Select 1 or 2","1","","","",2)

 G END:$D(DUOUT),END:$D(DTOUT)

 I ACHDSELV=1 K ACHDVIEN G DEV

VEND ;Select one vendor

 S DIC(0)="AEQMZ",DIC="^AUTTVNDR(",DIC("A")="Enter Provider/Vendor:  "

    S:DIC(0)["L" DLAYGO=9999999.11

    D ^DIC

    K DIC,DLAYGO

    G SELV:Y=-1

    S ACHDVIEN=+Y

DEV ;

 S %ZIS="PQ"

 D ^%ZIS

 I POP D HOME^%ZIS G END

 G:'$D(IO("Q")) START

 S ZTRTN="START^ACHSDPVO2",ZTIO="",ZTDESC="CHS DENIAL "_$P($P($T(ACHSDPVO),"-",2)," ",2,5),ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL

 F %="ACHDBDT","ACHDEDT","ACHSQIO" S ZTSAVE(%)=""

 D ^%ZTLOAD

 G:'$D(ZTQUEUED) DEV

END ;

 K ACHDBDT,ACHDEDT,ACHDX

START ;

 S ACHD=ACHDBDT-1

 K ^TMP("ACHSDPVO2",$J)

GO1 ;

 S ACHD=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHD))

 G PRINT:+ACHD=0,PRINT:ACHD>ACHDEDT,GO1:ACHD<ACHDBDT

 S ACHDX=0

GO2 ;

 S ACHDX=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHD,ACHDX))

 G GO1:+ACHDX=0

 G GO2:$P($G(^ACHSDEN(DUZ(2),"D",ACHDX,100)),U)'="Y"

 G GO2:'$G(^ACHSDEN(DUZ(2),"D",ACHDX,250))

 S X=$G(^ACHSDEN(DUZ(2),"D",ACHDX,100)),ACHDPROV=$P(X,U,2),ACHDECHG=$P(X,U,8),ACHDACHG=$P(X,U,9),ACHDTOS=$P(X,U,10)

 I (ACHDSELV=2),(ACHDPROV'=ACHDVIEN) G GO2    ;test for single vendor

 S X=$G(^ACHSDEN(DUZ(2),"D",ACHDX,0)),ACHDN=$P(X,U),ACHDAT=$P(X,U,2)

 I $P(X,U,6)="N" Q:$P($G(^ACHSDEN(DUZ(2),"D",ACHDX,10)),U)=""  S ACHSNAME=$P(^ACHSDEN(DUZ(2),"D",ACHDX,10),U)

 I $P(X,U,6)="Y" Q:$P(X,U,7)=""  S ACHSNAME=$P($G(^DPT($P(X,U,7),0)),U) Q:ACHSNAME=""

 S ACHSDOS=$P(^ACHSDEN(DUZ(2),"D",ACHDX,0),U,4)

 ..S Y=ACHSDOS X ^DD("DD") S ACHSDOS=Y

 S ACHDNR=$P($G(^ACHSDEN(DUZ(2),"D",ACHDX,250)),U),ACHDNRO=$P($G(^ACHSDEN(DUZ(2),"D",ACHDX,250)),U,2)

 S:'ACHDNRO ACHDNRO="UNKNOWN"

 S ^TMP("ACHSDPVO2",$J,ACHDPROV,ACHDNR,ACHDNRO,ACHDAT,ACHDN)=ACHDECHG_U_ACHDACHG_U_ACHDTOS_U_ACHSNAME_U_ACHSDOS

 G GO2

PRINT ;

 S ACHDTIT=$$C^ACHS("CONTRACT HEALTH PROVIDER (ON-FILE) REPORT")

 D BRPT^ACHS

 D HDR

 G END1:$G(ACHSQUIT)

 I '$D(^TMP("ACHSDPVO2",$J)) W !!!,"NO DOCUMENTS FOR THIS REPORT",!!! G END1

 S (ACHDPROV,ACHDETOT,ACHDATOT)=0

PRNT1 ;

 I $Y>ACHSBM D HDR G END1:$G(ACHSQUIT)

 W !,$$REPEAT^XLFSTR("=",79)

 S ACHDPROV=$O(^TMP("ACHSDPVO2",$J,ACHDPROV))

 G TOTAL:ACHDPROV=""

 W !?20,"PROVIDER: ",$P($G(^AUTTVNDR(ACHDPROV,0)),U),!,$$REPEAT^XLFSTR("-",79),!

 S (ACHDNR,ACHDTE,ACHDTA)=0

PRNT2 ;

 S ACHDNR=$O(^TMP("ACHSDPVO2",$J,ACHDPROV,ACHDNR))

 I +ACHDNR=0 D SUBTOT G PRNT1

 S ACHDNRO=0

PRNT25 ;OPTIONS

 S ACHDNRO=$O(^TMP("ACHSDPVO2",$J,ACHDPROV,ACHDNR,ACHDNRO))

 G PRNT2:+ACHDNRO=0

 W !?5,"PRIMARY DENIAL REASON: ",$P($G(^ACHSDENS(ACHDNR,0)),U),!

 W !?5,"PRIMARY DENIAL OPTION: ",$P($G(^ACHSDENS(ACHDNR,20,ACHDNRO,0)),U),!

 D HDR1

 S ACHDAT=0

PRNT3 ;

 S ACHDAT=$O(^TMP("ACHSDPVO2",$J,ACHDPROV,ACHDNR,ACHDNRO,ACHDAT))

 G PRNT25:+ACHDAT=0

 S ACHDN=0

PRNT4 ;

 S ACHDN=$O(^TMP("ACHSDPVO2",$J,ACHDPROV,ACHDNR,ACHDNRO,ACHDAT,ACHDN))

 G PRNT3:+ACHDN=0

 S X=$G(^TMP("ACHSDPVO2",$J,ACHDPROV,ACHDNR,ACHDNRO,ACHDAT,ACHDN)),ACHSNAME=$P(X,U,4),ACHSDOS=$P(X,U,5),ACHDECHG=$P(X,U)

 S ACHDACHG=$P(X,U,2),ACHDTOS=$P(X,U,3),ACHDTE=ACHDTE+ACHDECHG,ACHDTA=ACHDTA+ACHDACHG,X=ACHDECHG,X2=2

 D COMMA^%DTC

 S ACHDECHG=X,X=ACHDACHG,X2=2

 D COMMA^%DTC

 S ACHDACHG=X

 W $$FMTE^XLFDT(ACHDAT),?15,ACHDN,?30,ACHSNAME,?55,$$FMTE^XLFDT(ACHSDOS),?67,ACHDECHG,!

 I $Y>ACHSBM D HDR G END1:$G(ACHSQUIT) D HDR1

 G PRNT4

SUBTOT ;

 S X=ACHDTE,X2=2

 D COMMA^%DTC

 S ACHDTET=X,X=ACHDTA,X2=2

 D COMMA^%DTC

 S ACHDTAT=X

 W !?67,"___________",!?20,"PROVIDER TOTAL",?67,$J(ACHDTET,8),!!

 S ACHDETOT=ACHDETOT+ACHDTE,ACHDATOT=ACHDATOT+ACHDTA

TOTAL ;

 S X=ACHDETOT,X2=2

 D COMMA^%DTC

 S ACHDETOT=X,X=ACHDATOT,X2=2

 D COMMA^%DTC

 S ACHDATOT=X

 W !!,$$REPEAT^XLFSTR("-",79),!!!?20,"TOTAL",?67,$J(ACHDETOT,10),!

END1 ;

 D ERPT^ACHS

 K ACHD,ACHDBDT,ACHDEDT,ACHDETOT,ACHDPROV,ACHDNR,ACHDAT,ACHDATOT,ACHDN,ACHDECHG,ACHDACHG,ACHDTAT,ACHDTE,ACHDTET,ACHDTIT,ACHDTOS

 K ACHDTA,ACHDVIEN,ACHDSELV,ACHDNRO,ACHSDOS,ACHSNAME

 K ^TMP("ACHSDPVO2",$J)

 D ^ACHSVAR:'$D(ZTQUEUED)

HDR ;

 D RTRN^ACHS

 Q:$G(ACHSQUIT)

 S ACHSPG=ACHSPG+1

 W @IOF,ACHSUSR,?70,"PAGE ",ACHSPG,!,ACHSLOC,!,ACHDTIT,!,$$C^ACHS("From "_$$FMTE^XLFDT(ACHDBDT)_" To "_$$FMTE^XLFDT(ACHDEDT)),!!,ACHSTIME,!

HDR1 ;

 W !,"ISSUE DATE",?15,"DOCUMENT #",?30,"PATIENT",?55,"DOS",?72,"EST AMT",!,$$REPEAT^XLFSTR("-",79),!

ACHSDPVO2.m