ACHSDPVO ; IHS/ITSC/PMF - PROVIDER ON FILE REPORT ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
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
DEV ;
S %ZIS="PQ"
D ^%ZIS
I POP D HOME^%ZIS G END
G:'$D(IO("Q")) START
S ZTRTN="START^ACHSDPVO",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
Q
;
START ;
S ACHD=ACHDBDT-1
K ^TMP($J,"ACHSDPVO")
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)
;
S X=$G(^ACHSDEN(DUZ(2),"D",ACHDX,0)),ACHDN=$P(X,U),ACHDAT=$P(X,U,2)
S ACHDNR=$P($G(^ACHSDEN(DUZ(2),"D",ACHDX,250)),U)
S ^TMP($J,"ACHSDPVO",ACHDPROV,ACHDNR,ACHDAT,ACHDN)=ACHDECHG_U_ACHDACHG_U_ACHDTOS
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($J,"ACHSDPVO")) 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($J,"ACHSDPVO",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($J,"ACHSDPVO",ACHDPROV,ACHDNR))
I +ACHDNR=0 D SUBTOT G PRNT1
W !?5,"PRIMARY DENIAL REASON: ",$P($G(^ACHSDENS(ACHDNR,0)),U),!
D HDR1
S ACHDAT=0
PRNT3 ;
S ACHDAT=$O(^TMP($J,"ACHSDPVO",ACHDPROV,ACHDNR,ACHDAT))
G PRNT2:+ACHDAT=0
S ACHDN=0
PRNT4 ;
S ACHDN=$O(^TMP($J,"ACHSDPVO",ACHDPROV,ACHDNR,ACHDAT,ACHDN))
G PRNT3:+ACHDN=0
S X=$G(^TMP($J,"ACHSDPVO",ACHDPROV,ACHDNR,ACHDAT,ACHDN)),ACHDECHG=$P(X,U),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,$S(ACHDTOS="I":"INPATIENT",ACHDTOS="O":"OUTPATIENT",1:"UNKNOWN"),?45,ACHDECHG,?60,ACHDACHG,!
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 !?45,"___________",?60,"___________",!?20,"PROVIDER TOTAL",?45,$J(ACHDTET,8),?60,$J(ACHDTAT,8),!!
S ACHDETOT=ACHDETOT+ACHDTE,ACHDATOT=ACHDATOT+ACHDTA
Q
;
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",?45,$J(ACHDETOT,10),?60,$J(ACHDATOT,10),!
END1 ;
D ERPT^ACHS
K ACHD,ACHDBDT,ACHDEDT,ACHDETOT,ACHDPROV,ACHDNR,ACHDAT,ACHDATOT,ACHDN,ACHDECHG,ACHDACHG,ACHDTAT,ACHDTE,ACHDTET,ACHDTIT,ACHDTOS,ACHDTA,^TMP($J,"ACHSDPVO")
Q
;
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,!
Q
;
HDR1 ;
W !,"ISSUE DATE",?15,"DOCUMENT #",?30,"TYPE SVC",?50,"EST AMT",?65,"ACT AMT",!,$$REPEAT^XLFSTR("-",79),!
Q
;
ACHSDPVO ; IHS/ITSC/PMF - PROVIDER ON FILE REPORT ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
GO ;
+1 SET ACHDBDT=$$DATE^ACHS("B","PROVIDER (On File)")
+2 IF ACHDBDT<1
GOTO END
+3 SET ACHDEDT=$$DATE^ACHS("E","PROVIDER (On File)")
+4 IF ACHDEDT<1
GOTO GO
DEV ;
+1 SET %ZIS="PQ"
+2 DO ^%ZIS
+3 IF POP
DO HOME^%ZIS
GOTO END
+4 IF '$DATA(IO("Q"))
GOTO START
+5 SET ZTRTN="START^ACHSDPVO"
SET ZTIO=""
SET ZTDESC="CHS DENIAL "_$PIECE($PIECE($TEXT(ACHSDPVO),"-",2)," ",2,5)
SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
+6 FOR %="ACHDBDT","ACHDEDT","ACHSQIO"
SET ZTSAVE(%)=""
+7 DO ^%ZTLOAD
+8 IF '$DATA(ZTQUEUED)
GOTO DEV
END ;
+1 KILL ACHDBDT,ACHDEDT,ACHDX
+2 QUIT
+3 ;
START ;
+1 SET ACHD=ACHDBDT-1
+2 KILL ^TMP($JOB,"ACHSDPVO")
GO1 ;
+1 SET ACHD=$ORDER(^ACHSDEN(DUZ(2),"D","AISSUE",ACHD))
+2 IF +ACHD=0
GOTO PRINT
IF ACHD>ACHDEDT
GOTO PRINT
IF ACHD<ACHDBDT
GOTO GO1
+3 SET ACHDX=0
GO2 ;
+1 SET ACHDX=$ORDER(^ACHSDEN(DUZ(2),"D","AISSUE",ACHD,ACHDX))
+2 IF +ACHDX=0
GOTO GO1
+3 IF $PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHDX,100)),U)'="Y"
GOTO GO2
+4 IF '$GET(^ACHSDEN(DUZ(2),"D",ACHDX,250))
GOTO GO2
+5 ;
+6 SET X=$GET(^ACHSDEN(DUZ(2),"D",ACHDX,100))
SET ACHDPROV=$PIECE(X,U,2)
SET ACHDECHG=$PIECE(X,U,8)
SET ACHDACHG=$PIECE(X,U,9)
SET ACHDTOS=$PIECE(X,U,10)
+7 ;
+8 SET X=$GET(^ACHSDEN(DUZ(2),"D",ACHDX,0))
SET ACHDN=$PIECE(X,U)
SET ACHDAT=$PIECE(X,U,2)
+9 SET ACHDNR=$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHDX,250)),U)
+10 SET ^TMP($JOB,"ACHSDPVO",ACHDPROV,ACHDNR,ACHDAT,ACHDN)=ACHDECHG_U_ACHDACHG_U_ACHDTOS
+11 GOTO GO2
+12 ;
PRINT ;
+1 SET ACHDTIT=$$C^ACHS("CONTRACT HEALTH PROVIDER (ON-FILE) REPORT")
+2 DO BRPT^ACHS
+3 DO HDR
+4 IF $GET(ACHSQUIT)
GOTO END1
+5 IF '$DATA(^TMP($JOB,"ACHSDPVO"))
WRITE !!!,"NO DOCUMENTS FOR THIS REPORT",!!!
GOTO END1
+6 SET (ACHDPROV,ACHDETOT,ACHDATOT)=0
PRNT1 ;
+1 IF $Y>ACHSBM
DO HDR
IF $GET(ACHSQUIT)
GOTO END1
+2 WRITE !,$$REPEAT^XLFSTR("=",79)
+3 SET ACHDPROV=$ORDER(^TMP($JOB,"ACHSDPVO",ACHDPROV))
+4 IF ACHDPROV=""
GOTO TOTAL
+5 WRITE !?20,"PROVIDER: ",$PIECE($GET(^AUTTVNDR(ACHDPROV,0)),U),!,$$REPEAT^XLFSTR("-",79),!
+6 SET (ACHDNR,ACHDTE,ACHDTA)=0
PRNT2 ;
+1 SET ACHDNR=$ORDER(^TMP($JOB,"ACHSDPVO",ACHDPROV,ACHDNR))
+2 IF +ACHDNR=0
DO SUBTOT
GOTO PRNT1
+3 WRITE !?5,"PRIMARY DENIAL REASON: ",$PIECE($GET(^ACHSDENS(ACHDNR,0)),U),!
+4 DO HDR1
+5 SET ACHDAT=0
PRNT3 ;
+1 SET ACHDAT=$ORDER(^TMP($JOB,"ACHSDPVO",ACHDPROV,ACHDNR,ACHDAT))
+2 IF +ACHDAT=0
GOTO PRNT2
+3 SET ACHDN=0
PRNT4 ;
+1 SET ACHDN=$ORDER(^TMP($JOB,"ACHSDPVO",ACHDPROV,ACHDNR,ACHDAT,ACHDN))
+2 IF +ACHDN=0
GOTO PRNT3
+3 SET X=$GET(^TMP($JOB,"ACHSDPVO",ACHDPROV,ACHDNR,ACHDAT,ACHDN))
SET ACHDECHG=$PIECE(X,U)
SET ACHDACHG=$PIECE(X,U,2)
SET ACHDTOS=$PIECE(X,U,3)
SET ACHDTE=ACHDTE+ACHDECHG
SET ACHDTA=ACHDTA+ACHDACHG
SET X=ACHDECHG
SET X2=2
+4 DO COMMA^%DTC
+5 SET ACHDECHG=X
SET X=ACHDACHG
SET X2=2
+6 DO COMMA^%DTC
+7 SET ACHDACHG=X
+8 WRITE $$FMTE^XLFDT(ACHDAT),?15,ACHDN,?30,$SELECT(ACHDTOS="I":"INPATIENT",ACHDTOS="O":"OUTPATIENT",1:"UNKNOWN"),?45,ACHDECHG,?60,ACHDACHG,!
+9 IF $Y>ACHSBM
DO HDR
IF $GET(ACHSQUIT)
GOTO END1
DO HDR1
+10 GOTO PRNT4
+11 ;
SUBTOT ;
+1 SET X=ACHDTE
SET X2=2
+2 DO COMMA^%DTC
+3 SET ACHDTET=X
SET X=ACHDTA
SET X2=2
+4 DO COMMA^%DTC
+5 SET ACHDTAT=X
+6 WRITE !?45,"___________",?60,"___________",!?20,"PROVIDER TOTAL",?45,$JUSTIFY(ACHDTET,8),?60,$JUSTIFY(ACHDTAT,8),!!
+7 SET ACHDETOT=ACHDETOT+ACHDTE
SET ACHDATOT=ACHDATOT+ACHDTA
+8 QUIT
+9 ;
TOTAL ;
+1 SET X=ACHDETOT
SET X2=2
+2 DO COMMA^%DTC
+3 SET ACHDETOT=X
SET X=ACHDATOT
SET X2=2
+4 DO COMMA^%DTC
+5 SET ACHDATOT=X
+6 WRITE !!,$$REPEAT^XLFSTR("-",79),!!!?20,"TOTAL",?45,$JUSTIFY(ACHDETOT,10),?60,$JUSTIFY(ACHDATOT,10),!
END1 ;
+1 DO ERPT^ACHS
+2 KILL ACHD,ACHDBDT,ACHDEDT,ACHDETOT,ACHDPROV,ACHDNR,ACHDAT,ACHDATOT,ACHDN,ACHDECHG,ACHDACHG,ACHDTAT,ACHDTE,ACHDTET,ACHDTIT,ACHDTOS,ACHDTA,^TMP($JOB,"ACHSDPVO")
+3 QUIT
+4 ;
HDR ;
+1 DO RTRN^ACHS
+2 IF $GET(ACHSQUIT)
QUIT
+3 SET ACHSPG=ACHSPG+1
+4 WRITE @IOF,ACHSUSR,?70,"PAGE ",ACHSPG,!,ACHSLOC,!,ACHDTIT,!,$$C^ACHS("From "_$$FMTE^XLFDT(ACHDBDT)_" To "_$$FMTE^XLFDT(ACHDEDT)),!!,ACHSTIME,!
+5 QUIT
+6 ;
HDR1 ;
+1 WRITE !,"ISSUE DATE",?15,"DOCUMENT #",?30,"TYPE SVC",?50,"EST AMT",?65,"ACT AMT",!,$$REPEAT^XLFSTR("-",79),!
+2 QUIT
+3 ;
