Routine: ACHSDPVO

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

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

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")

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,"TYPE SVC",?50,"EST AMT",?65,"ACT AMT",!,$$REPEAT^XLFSTR("-",79),!

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       ;

ACHSDPVO.m