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

ACHSDPVN.m

Go to the documentation of this file. 
  1. ACHSDPVN ; IHS/ITSC/PMF - PROVIDER NOT ON FILE REPORT ;    [ 01/03/2002  2:45 PM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**2**;JUN 11, 2001
  1.  ;;ACHS*3.1*2; Check for presence of all necessary vars
  1.  ;
  1.  ;
  1. GO ;
  1.  S ACHDBDT=$$DATE^ACHS("B","PROVIDER (NOT On File)")
  1.  I ACHDBDT<1 D END Q
  1.  S ACHDEDT=$$DATE^ACHS("E","PROVIDER (NOT On File)")
  1.  G GO:ACHDEDT<1
  1. DEV ;
  1.  S %ZIS="PQ"
  1.  D ^%ZIS
  1.  I POP D HOME^%ZIS D END Q
  1.  G:'$D(IO("Q")) START
  1.  S ZTRTN="START^ACHSDPVN",ZTIO="",ZTDESC="CHS DENIAL Provider (Not On-File) Report",ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
  1.  F %="ACHDBDT","ACHDEDT","ACHSQIO" S ZTSAVE(%)=""
  1.  D ^%ZTLOAD
  1.  G:'$D(ZTQUEUED) DEV
  1. END ;
  1.  D ^%ZISC
  1.  K ACHDBDT,ACHDEDT,ACHDX
  1.  Q
  1.  ;
  1. START ;EP - From TaskMan.
  1.  S ACHDTIT=$$C^ACHS("CONTRACT HEALTH PROVIDER (NOT ON-FILE) REPORT",80)
  1.  S ACHD=ACHDBDT-1
  1.  K ^TMP($J,"ACHSDPVN")
  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,GO2:'$D(^ACHSDEN(DUZ(2),"D",ACHDX,100))
  1.  G GO2:$P($G(^ACHSDEN(DUZ(2),"D",ACHDX,100)),U)'="N"
  1.  ;
  1.  S X=$G(^ACHSDEN(DUZ(2),"D",ACHDX,100)),ACHDPROV=$P(X,U,3),ACHDECHG=$P(X,U,8),ACHDACHG=$P(X,U,9),ACHDTOS=$P(X,U,10)
  1.  S X=$G(^ACHSDEN(DUZ(2),"D",ACHDX,0)),ACHDN=$P(X,U),ACHDAT=$P(X,U,2)
  1.  G:'$D(^ACHSDEN(DUZ(2),"D",ACHDX,250)) GO2
  1.  ;
  1.  S ACHDNR=$P($G(^ACHSDEN(DUZ(2),"D",ACHDX,250)),U)
  1.  ;
  1.  ;1/3/02  pmf  check for these elements before continuing  ACHS*3.1*2
  1.  F ACHSYAYA="ACHDPROV","ACHDNR","ACHDAT","ACHDN" I @ACHSYAYA="" G GO2 ; ACHS*3.1*2
  1.  ;
  1.  S ^TMP($J,"ACHSDPVN",ACHDPROV,ACHDNR,ACHDAT,ACHDN)=ACHDECHG_U_ACHDACHG_U_ACHDTOS
  1.  G GO2
  1.  ;
  1. PRINT ;
  1.  D BRPT^ACHS
  1.  D HDR
  1.  G END1:$G(ACHSQUIT)
  1.  I '$D(^TMP($J,"ACHSDPVN")) 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($J,"ACHSDPVN",ACHDPROV))
  1.  G TOTAL:ACHDPROV=""
  1.  W !?20,"PROVIDER: ",ACHDPROV,!,$$REPEAT^XLFSTR("-",79),!
  1.  S (ACHDNR,ACHDTE,ACHDTA)=0
  1. PRNT2 ;
  1.  S ACHDNR=$O(^TMP($J,"ACHSDPVN",ACHDPROV,ACHDNR))
  1.  I +ACHDNR=0 D SUBTOT G PRNT1
  1.  W !?5,"PRIMARY DENIAL REASON: ",$P($G(^ACHSDENS(ACHDNR,0)),U),!
  1.  D HDR1
  1.  S ACHDAT=0
  1. PRNT3 ;   
  1.  S ACHDAT=$O(^TMP($J,"ACHSDPVN",ACHDPROV,ACHDNR,ACHDAT))
  1.  G PRNT2:+ACHDAT=0
  1.  S ACHDN=0
  1. PRNT4 ;
  1.  S ACHDN=$O(^TMP($J,"ACHSDPVN",ACHDPROV,ACHDNR,ACHDAT,ACHDN))
  1.  G PRNT3:+ACHDN=0
  1.  S X=$G(^TMP($J,"ACHSDPVN",ACHDPROV,ACHDNR,ACHDAT,ACHDN))
  1.  S ACHDECHG=$P(X,U)
  1.  S ACHDACHG=$P(X,U,2)
  1.  S ACHDTOS=$P(X,U,3)
  1.  S ACHDTE=ACHDTE+ACHDECHG
  1.  S ACHDTA=ACHDTA+ACHDACHG
  1.  S 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,$S(ACHDTOS="I":"INPATIENT",ACHDTOS="O":"OUTPATIENT",1:"UNKNOWN"),?45,ACHDECHG,?60,ACHDACHG,!
  1.  I $Y>ACHSBM D HDR,HDR1 G END1:$G(ACHSQUIT)
  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 !?45,"___________",?60,"___________",!?20,"PROVIDER TOTAL",?45,$J(ACHDTET,8),?60,$J(ACHDTAT,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 S ACHDATOT=X
  1.  W !!,$$REPEAT^XLFSTR("-",79),!!!?20,"TOTAL",?45,$J(ACHDETOT,10),?60,$J(ACHDATOT,10),!
  1. END1 ;
  1.  D ERPT^ACHS
  1.  K ACHD,ACHDBDT,ACHDEDT,ACHDETOT,ACHDPROV,ACHDNR,ACHDAT,ACHDATOT,ACHDN,ACHDECHG,ACHDACHG,ACHDTAT,ACHDTE,ACHDTET,ACHDTIT,ACHDTOS,ACHDTA,^TMP($J,"ACHSDPVN")
  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,"TYPE SVC",?49,"EST AMT",?64,"ACT AMT",!,$$REPEAT^XLFSTR("-",79),!
  1.  Q
  1.  ;