ACHSDPVN ; IHS/ITSC/PMF - PROVIDER NOT ON FILE REPORT ; [ 01/03/2002 2:45 PM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**2**;JUN 11, 2001
;;ACHS*3.1*2; Check for presence of all necessary vars
;
;
GO ;
S ACHDBDT=$$DATE^ACHS("B","PROVIDER (NOT On File)")
I ACHDBDT<1 D END Q
S ACHDEDT=$$DATE^ACHS("E","PROVIDER (NOT On File)")
G GO:ACHDEDT<1
DEV ;
S %ZIS="PQ"
D ^%ZIS
I POP D HOME^%ZIS D END Q
G:'$D(IO("Q")) START
S ZTRTN="START^ACHSDPVN",ZTIO="",ZTDESC="CHS DENIAL Provider (Not On-File) Report",ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
F %="ACHDBDT","ACHDEDT","ACHSQIO" S ZTSAVE(%)=""
D ^%ZTLOAD
G:'$D(ZTQUEUED) DEV
END ;
D ^%ZISC
K ACHDBDT,ACHDEDT,ACHDX
Q
;
START ;EP - From TaskMan.
S ACHDTIT=$$C^ACHS("CONTRACT HEALTH PROVIDER (NOT ON-FILE) REPORT",80)
S ACHD=ACHDBDT-1
K ^TMP($J,"ACHSDPVN")
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,GO2:'$D(^ACHSDEN(DUZ(2),"D",ACHDX,100))
G GO2:$P($G(^ACHSDEN(DUZ(2),"D",ACHDX,100)),U)'="N"
;
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)
S X=$G(^ACHSDEN(DUZ(2),"D",ACHDX,0)),ACHDN=$P(X,U),ACHDAT=$P(X,U,2)
G:'$D(^ACHSDEN(DUZ(2),"D",ACHDX,250)) GO2
;
S ACHDNR=$P($G(^ACHSDEN(DUZ(2),"D",ACHDX,250)),U)
;
;1/3/02 pmf check for these elements before continuing ACHS*3.1*2
F ACHSYAYA="ACHDPROV","ACHDNR","ACHDAT","ACHDN" I @ACHSYAYA="" G GO2 ; ACHS*3.1*2
;
S ^TMP($J,"ACHSDPVN",ACHDPROV,ACHDNR,ACHDAT,ACHDN)=ACHDECHG_U_ACHDACHG_U_ACHDTOS
G GO2
;
PRINT ;
D BRPT^ACHS
D HDR
G END1:$G(ACHSQUIT)
I '$D(^TMP($J,"ACHSDPVN")) 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,"ACHSDPVN",ACHDPROV))
G TOTAL:ACHDPROV=""
W !?20,"PROVIDER: ",ACHDPROV,!,$$REPEAT^XLFSTR("-",79),!
S (ACHDNR,ACHDTE,ACHDTA)=0
PRNT2 ;
S ACHDNR=$O(^TMP($J,"ACHSDPVN",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,"ACHSDPVN",ACHDPROV,ACHDNR,ACHDAT))
G PRNT2:+ACHDAT=0
S ACHDN=0
PRNT4 ;
S ACHDN=$O(^TMP($J,"ACHSDPVN",ACHDPROV,ACHDNR,ACHDAT,ACHDN))
G PRNT3:+ACHDN=0
S X=$G(^TMP($J,"ACHSDPVN",ACHDPROV,ACHDNR,ACHDAT,ACHDN))
S ACHDECHG=$P(X,U)
S ACHDACHG=$P(X,U,2)
S ACHDTOS=$P(X,U,3)
S ACHDTE=ACHDTE+ACHDECHG
S ACHDTA=ACHDTA+ACHDACHG
S 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,HDR1 G END1:$G(ACHSQUIT)
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,"ACHSDPVN")
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",?49,"EST AMT",?64,"ACT AMT",!,$$REPEAT^XLFSTR("-",79),!
Q
;
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
+2 ;;ACHS*3.1*2; Check for presence of all necessary vars
+3 ;
+4 ;
GO ;
+1 SET ACHDBDT=$$DATE^ACHS("B","PROVIDER (NOT On File)")
+2 IF ACHDBDT<1
DO END
QUIT
+3 SET ACHDEDT=$$DATE^ACHS("E","PROVIDER (NOT On File)")
+4 IF ACHDEDT<1
GOTO GO
DEV ;
+1 SET %ZIS="PQ"
+2 DO ^%ZIS
+3 IF POP
DO HOME^%ZIS
DO END
QUIT
+4 IF '$DATA(IO("Q"))
GOTO START
+5 SET ZTRTN="START^ACHSDPVN"
SET ZTIO=""
SET ZTDESC="CHS DENIAL Provider (Not On-File) Report"
SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
+6 FOR %="ACHDBDT","ACHDEDT","ACHSQIO"
SET ZTSAVE(%)=""
+7 DO ^%ZTLOAD
+8 IF '$DATA(ZTQUEUED)
GOTO DEV
END ;
+1 DO ^%ZISC
+2 KILL ACHDBDT,ACHDEDT,ACHDX
+3 QUIT
+4 ;
START ;EP - From TaskMan.
+1 SET ACHDTIT=$$C^ACHS("CONTRACT HEALTH PROVIDER (NOT ON-FILE) REPORT",80)
+2 SET ACHD=ACHDBDT-1
+3 KILL ^TMP($JOB,"ACHSDPVN")
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
IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHDX,100))
GOTO GO2
+3 IF $PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHDX,100)),U)'="N"
GOTO GO2
+4 ;
+5 SET X=$GET(^ACHSDEN(DUZ(2),"D",ACHDX,100))
SET ACHDPROV=$PIECE(X,U,3)
SET ACHDECHG=$PIECE(X,U,8)
SET ACHDACHG=$PIECE(X,U,9)
SET ACHDTOS=$PIECE(X,U,10)
+6 SET X=$GET(^ACHSDEN(DUZ(2),"D",ACHDX,0))
SET ACHDN=$PIECE(X,U)
SET ACHDAT=$PIECE(X,U,2)
+7 IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHDX,250))
GOTO GO2
+8 ;
+9 SET ACHDNR=$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHDX,250)),U)
+10 ;
+11 ;1/3/02 pmf check for these elements before continuing ACHS*3.1*2
+12 ; ACHS*3.1*2
FOR ACHSYAYA="ACHDPROV","ACHDNR","ACHDAT","ACHDN"
IF @ACHSYAYA=""
GOTO GO2
+13 ;
+14 SET ^TMP($JOB,"ACHSDPVN",ACHDPROV,ACHDNR,ACHDAT,ACHDN)=ACHDECHG_U_ACHDACHG_U_ACHDTOS
+15 GOTO GO2
+16 ;
PRINT ;
+1 DO BRPT^ACHS
+2 DO HDR
+3 IF $GET(ACHSQUIT)
GOTO END1
+4 IF '$DATA(^TMP($JOB,"ACHSDPVN"))
WRITE !!!,"NO DOCUMENTS FOR THIS REPORT",!!!
GOTO END1
+5 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,"ACHSDPVN",ACHDPROV))
+4 IF ACHDPROV=""
GOTO TOTAL
+5 WRITE !?20,"PROVIDER: ",ACHDPROV,!,$$REPEAT^XLFSTR("-",79),!
+6 SET (ACHDNR,ACHDTE,ACHDTA)=0
PRNT2 ;
+1 SET ACHDNR=$ORDER(^TMP($JOB,"ACHSDPVN",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,"ACHSDPVN",ACHDPROV,ACHDNR,ACHDAT))
+2 IF +ACHDAT=0
GOTO PRNT2
+3 SET ACHDN=0
PRNT4 ;
+1 SET ACHDN=$ORDER(^TMP($JOB,"ACHSDPVN",ACHDPROV,ACHDNR,ACHDAT,ACHDN))
+2 IF +ACHDN=0
GOTO PRNT3
+3 SET X=$GET(^TMP($JOB,"ACHSDPVN",ACHDPROV,ACHDNR,ACHDAT,ACHDN))
+4 SET ACHDECHG=$PIECE(X,U)
+5 SET ACHDACHG=$PIECE(X,U,2)
+6 SET ACHDTOS=$PIECE(X,U,3)
+7 SET ACHDTE=ACHDTE+ACHDECHG
+8 SET ACHDTA=ACHDTA+ACHDACHG
+9 SET X=ACHDECHG
SET X2=2
+10 DO COMMA^%DTC
+11 SET ACHDECHG=X
SET X=ACHDACHG
SET X2=2
+12 DO COMMA^%DTC
+13 SET ACHDACHG=X
+14 WRITE $$FMTE^XLFDT(ACHDAT),?15,ACHDN,?30,$SELECT(ACHDTOS="I":"INPATIENT",ACHDTOS="O":"OUTPATIENT",1:"UNKNOWN"),?45,ACHDECHG,?60,ACHDACHG,!
+15 IF $Y>ACHSBM
DO HDR
DO HDR1
IF $GET(ACHSQUIT)
GOTO END1
+16 GOTO PRNT4
+17 ;
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
SET ACHDATOT=X
+5 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,"ACHSDPVN")
+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",?49,"EST AMT",?64,"ACT AMT",!,$$REPEAT^XLFSTR("-",79),!
+2 QUIT
+3 ;
