Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSDPVO2

ACHSDPVO2.m

Go to the documentation of this file.
  1. ACHSDPVO ; IHS/OIT/FCJ - PROVIDER ON FILE REPORT-SPECIFIC VENDOR ;
  1. ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**26**;JUN 11, 2001;Build 43
  1. ;ORIGNAL RTN IS PROVIDER ON FILE DENIAL REPORT
  1. ;THE REPORT WAS MODIFIED TO PRINT PATIENT INFORMATION, SPECIFIC VENDOR
  1. ;AND DENIAL OPTIONS
  1. ;
  1. GO ;
  1. S ACHDBDT=$$DATE^ACHS("B","PROVIDER (On File)")
  1. G END:ACHDBDT<1
  1. S ACHDEDT=$$DATE^ACHS("E","PROVIDER (On File)")
  1. G GO:ACHDEDT<1
  1. SELV ;
  1. ; all or select one vendor to run
  1. S ACHDSELV=$$DIR^XBDIR("S^1:ALL Vendors;2:One Vendor only","Select 1 or 2","1","","","",2)
  1. G END:$D(DUOUT),END:$D(DTOUT)
  1. I ACHDSELV=1 K ACHDVIEN G DEV
  1. VEND ;Select one vendor
  1. S DIC(0)="AEQMZ",DIC="^AUTTVNDR(",DIC("A")="Enter Provider/Vendor: "
  1. S:DIC(0)["L" DLAYGO=9999999.11
  1. D ^DIC
  1. K DIC,DLAYGO
  1. G SELV:Y=-1
  1. S ACHDVIEN=+Y
  1. DEV ;
  1. S %ZIS="PQ"
  1. D ^%ZIS
  1. I POP D HOME^%ZIS G END
  1. G:'$D(IO("Q")) START
  1. S ZTRTN="START^ACHSDPVO2",ZTIO="",ZTDESC="CHS DENIAL "_$P($P($T(ACHSDPVO),"-",2)," ",2,5),ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
  1. F %="ACHDBDT","ACHDEDT","ACHSQIO" S ZTSAVE(%)=""
  1. D ^%ZTLOAD
  1. G:'$D(ZTQUEUED) DEV
  1. END ;
  1. K ACHDBDT,ACHDEDT,ACHDX
  1. Q
  1. ;
  1. START ;
  1. S ACHD=ACHDBDT-1
  1. K ^TMP("ACHSDPVO2",$J)
  1. GO1 ;
  1. S ACHD=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHD))
  1. G PRINT:+ACHD=0,PRINT:ACHD>ACHDEDT,GO1:ACHD<ACHDBDT
  1. S ACHDX=0
  1. GO2 ;
  1. S ACHDX=$O(^ACHSDEN(DUZ(2),"D","AISSUE",ACHD,ACHDX))
  1. G GO1:+ACHDX=0
  1. G GO2:$P($G(^ACHSDEN(DUZ(2),"D",ACHDX,100)),U)'="Y"
  1. G GO2:'$G(^ACHSDEN(DUZ(2),"D",ACHDX,250))
  1. ;
  1. 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)
  1. ;
  1. I (ACHDSELV=2),(ACHDPROV'=ACHDVIEN) G GO2 ;test for single vendor
  1. ;
  1. S X=$G(^ACHSDEN(DUZ(2),"D",ACHDX,0)),ACHDN=$P(X,U),ACHDAT=$P(X,U,2)
  1. 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)
  1. I $P(X,U,6)="Y" Q:$P(X,U,7)="" S ACHSNAME=$P($G(^DPT($P(X,U,7),0)),U) Q:ACHSNAME=""
  1. S ACHSDOS=$P(^ACHSDEN(DUZ(2),"D",ACHDX,0),U,4)
  1. ..S Y=ACHSDOS X ^DD("DD") S ACHSDOS=Y
  1. S ACHDNR=$P($G(^ACHSDEN(DUZ(2),"D",ACHDX,250)),U),ACHDNRO=$P($G(^ACHSDEN(DUZ(2),"D",ACHDX,250)),U,2)
  1. S:'ACHDNRO ACHDNRO="UNKNOWN"
  1. S ^TMP("ACHSDPVO2",$J,ACHDPROV,ACHDNR,ACHDNRO,ACHDAT,ACHDN)=ACHDECHG_U_ACHDACHG_U_ACHDTOS_U_ACHSNAME_U_ACHSDOS
  1. G GO2
  1. ;
  1. PRINT ;
  1. S ACHDTIT=$$C^ACHS("CONTRACT HEALTH PROVIDER (ON-FILE) REPORT")
  1. D BRPT^ACHS
  1. D HDR
  1. G END1:$G(ACHSQUIT)
  1. I '$D(^TMP("ACHSDPVO2",$J)) W !!!,"NO DOCUMENTS FOR THIS REPORT",!!! G END1
  1. S (ACHDPROV,ACHDETOT,ACHDATOT)=0
  1. PRNT1 ;
  1. I $Y>ACHSBM D HDR G END1:$G(ACHSQUIT)
  1. W !,$$REPEAT^XLFSTR("=",79)
  1. S ACHDPROV=$O(^TMP("ACHSDPVO2",$J,ACHDPROV))
  1. G TOTAL:ACHDPROV=""
  1. W !?20,"PROVIDER: ",$P($G(^AUTTVNDR(ACHDPROV,0)),U),!,$$REPEAT^XLFSTR("-",79),!
  1. S (ACHDNR,ACHDTE,ACHDTA)=0
  1. PRNT2 ;
  1. S ACHDNR=$O(^TMP("ACHSDPVO2",$J,ACHDPROV,ACHDNR))
  1. I +ACHDNR=0 D SUBTOT G PRNT1
  1. S ACHDNRO=0
  1. PRNT25 ;OPTIONS
  1. S ACHDNRO=$O(^TMP("ACHSDPVO2",$J,ACHDPROV,ACHDNR,ACHDNRO))
  1. G PRNT2:+ACHDNRO=0
  1. W !?5,"PRIMARY DENIAL REASON: ",$P($G(^ACHSDENS(ACHDNR,0)),U),!
  1. W !?5,"PRIMARY DENIAL OPTION: ",$P($G(^ACHSDENS(ACHDNR,20,ACHDNRO,0)),U),!
  1. D HDR1
  1. S ACHDAT=0
  1. PRNT3 ;
  1. S ACHDAT=$O(^TMP("ACHSDPVO2",$J,ACHDPROV,ACHDNR,ACHDNRO,ACHDAT))
  1. G PRNT25:+ACHDAT=0
  1. S ACHDN=0
  1. PRNT4 ;
  1. S ACHDN=$O(^TMP("ACHSDPVO2",$J,ACHDPROV,ACHDNR,ACHDNRO,ACHDAT,ACHDN))
  1. G PRNT3:+ACHDN=0
  1. 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)
  1. S ACHDACHG=$P(X,U,2),ACHDTOS=$P(X,U,3),ACHDTE=ACHDTE+ACHDECHG,ACHDTA=ACHDTA+ACHDACHG,X=ACHDECHG,X2=2
  1. D COMMA^%DTC
  1. S ACHDECHG=X,X=ACHDACHG,X2=2
  1. D COMMA^%DTC
  1. S ACHDACHG=X
  1. W $$FMTE^XLFDT(ACHDAT),?15,ACHDN,?30,ACHSNAME,?55,$$FMTE^XLFDT(ACHSDOS),?67,ACHDECHG,!
  1. I $Y>ACHSBM D HDR G END1:$G(ACHSQUIT) D HDR1
  1. G PRNT4
  1. ;
  1. SUBTOT ;
  1. S X=ACHDTE,X2=2
  1. D COMMA^%DTC
  1. S ACHDTET=X,X=ACHDTA,X2=2
  1. D COMMA^%DTC
  1. S ACHDTAT=X
  1. W !?67,"___________",!?20,"PROVIDER TOTAL",?67,$J(ACHDTET,8),!!
  1. S ACHDETOT=ACHDETOT+ACHDTE,ACHDATOT=ACHDATOT+ACHDTA
  1. Q
  1. ;
  1. TOTAL ;
  1. S X=ACHDETOT,X2=2
  1. D COMMA^%DTC
  1. S ACHDETOT=X,X=ACHDATOT,X2=2
  1. D COMMA^%DTC
  1. S ACHDATOT=X
  1. W !!,$$REPEAT^XLFSTR("-",79),!!!?20,"TOTAL",?67,$J(ACHDETOT,10),!
  1. ;
  1. END1 ;
  1. D ERPT^ACHS
  1. K ACHD,ACHDBDT,ACHDEDT,ACHDETOT,ACHDPROV,ACHDNR,ACHDAT,ACHDATOT,ACHDN,ACHDECHG,ACHDACHG,ACHDTAT,ACHDTE,ACHDTET,ACHDTIT,ACHDTOS
  1. K ACHDTA,ACHDVIEN,ACHDSELV,ACHDNRO,ACHSDOS,ACHSNAME
  1. K ^TMP("ACHSDPVO2",$J)
  1. D ^ACHSVAR:'$D(ZTQUEUED)
  1. Q
  1. ;
  1. HDR ;
  1. D RTRN^ACHS
  1. Q:$G(ACHSQUIT)
  1. S ACHSPG=ACHSPG+1
  1. W @IOF,ACHSUSR,?70,"PAGE ",ACHSPG,!,ACHSLOC,!,ACHDTIT,!,$$C^ACHS("From "_$$FMTE^XLFDT(ACHDBDT)_" To "_$$FMTE^XLFDT(ACHDEDT)),!!,ACHSTIME,!
  1. Q
  1. ;
  1. HDR1 ;
  1. W !,"ISSUE DATE",?15,"DOCUMENT #",?30,"PATIENT",?55,"DOS",?72,"EST AMT",!,$$REPEAT^XLFSTR("-",79),!
  1. Q
  1. ;