ACHSCPTF.m

ACHSCPTF ; IHS/ITSC/TPF/PMF - PRINT CHS CPT CODE REPORT-BY VENDOR/SUMMARY ; JUL 10, 2008 

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**14**;JUN 11,2001

 ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES

 ;

 D BRPT^ACHSFU

 S (ACHSPAGE,C,ACHSCHBS,ACHSDOCT,ACHSDGT,ACHSDOC,ACHSCHAT,ACHSCHBT,ACHSCHAS,ACHS43S,ACHS43T,ACHS57S,ACHS57T,ACHS64S,ACHS64T,ACHSCS,ACHSCT)=0

 S ACHSVNDR=""

P1 ; 

 S ACHSVNDR=$O(^TMP("ACHSCPT",$J,ACHSVNDR))

 G TOTL:ACHSVNDR=""

 I ACHSVNDR=0 G NODATA1

 I $D(^TMP("ACHSCPT",$J,ACHSVNDR,0)) G NODATA

 S ACHSCODE=""

 D HEADER,HEADER1

P2 ; 

 S ACHSCODE=$O(^TMP("ACHSCPT",$J,ACHSVNDR,ACHSCODE))

 G:ACHSCODE="" SUBTOTL

 S ACHSDOCS=$P($G(^TMP("ACHSCPT",$J,ACHSVNDR,ACHSCODE)),U)

 S ACHSCHB=$P($G(^TMP("ACHSCPT",$J,ACHSVNDR,ACHSCODE)),U,2)

 S ACHSCHA=$P($G(^TMP("ACHSCPT",$J,ACHSVNDR,ACHSCODE)),U,3)

 ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 4 LINES

 ;S ACHSCODP=$S($D(^ICPT(ACHSCODE,0)):$P($G(^ICPT(ACHSCODE,0)),U,2),1:"NOT ON FILE")

 S ACHSCODP=$S($D(^ICPT(ACHSCODE,0)):$P($$CPT^ICPTCOD(ACHSCODE),U,3),1:"NOT ON FILE")

 ;S ACHSCOD=$S($D(^ICPT(ACHSCODE,0)):$P($G(^ICPT(ACHSCODE,0)),U),1:ACHSCODE)

 S ACHSCOD=$S($D(^ICPT(ACHSCODE,0)):$P($$CPT^ICPTCOD(ACHSCODE),U,2),1:ACHSCODE)

PRINT ;Prints data totals

 W !?1,$J(ACHSCOD,6)_"-"_ACHSCODP,?40,$J(ACHSDOCS,4)

 S X=ACHSCHB,X2=2

 D COMMA^%DTC

 W ?50,X

 S X=ACHSCHA,X2=2

 D COMMA^%DTC

 W ?65,X

 I IOST["P-"&($Y>56) D HEADER,HEADER1

 I IOST["C-",'$D(IO("S"))&($Y>24) K DIR S DIR(0)="E" W !! D ^DIR G END:Y=0 D HEADER,HEADER1

 S Z=$G(^TMP("ACHSCPT",$J,ACHSVNDR,ACHSCODE))

 S ACHS43=$P(Z,U,4),ACHS57=$P(Z,U,5),ACHS64=$P(Z,U,6),ACHS43S=ACHS43S+ACHS43,ACHS57S=ACHS57S+ACHS57,ACHS64S=ACHS64S+ACHS64

 S ACHSCHBS=ACHSCHBS+ACHSCHB,ACHSCHAS=ACHSCHAS+ACHSCHA,ACHSDOCT=ACHSDOCT+ACHSDOCS,ACHSCS=ACHSCS+1

 S (ACHSCHB,ACHSDOCS,ACHSCHA,C)=0

 G P2

 ;

SUBTOTL ; Print subtotals.

 W !!,$$REPEAT^XLFSTR("-",80),!?1,"SUBTOTAL",?10,ACHSCS,?40,$J(ACHSDOCT,4)

 S X=ACHSCHBS,X2="2$"

 D COMMA^%DTC

 W ?50,X

 S X=ACHSCHAS,X2="2$"

 D COMMA^%DTC

 W ?65,X

 I ACHSCHBS>0&(ACHSCHAS>0) S X=(ACHSCHAS/ACHSCHBS)*100 W !!?1,"PERCENTAGE OF CHGS ALLOWED TO CHGS BILLED" W ?61,$E(X,1,5)_"%"

 W !!?3,"** HOSP - "_ACHS43S_" **",?32,"** DENT - "_ACHS57S_" **",?62,"** OUTP - "_ACHS64S_" **"

 S ACHSCHBT=ACHSCHBT+ACHSCHBS,ACHSCHAT=ACHSCHAT+ACHSCHAS,ACHSDGT=ACHSDGT+ACHSDOCT

 S ACHS43T=ACHS43T+ACHS43S,ACHS57T=ACHS57T+ACHS57S,ACHS64T=ACHS64T+ACHS64S,ACHSCT=ACHSCT+ACHSCS

 K DIR

 I IOST["C-",'$D(IO("S")) S DIR(0)="E" W !! D ^DIR G END:Y=0

 S (C,ACHSCHBS,ACHSCHAS,ACHSDOCT,ACHSPAGE,ACHS43S,ACHS57S,ACHS64S,ACHSCS)=0

 G P1

 ;

TOTL ; Print totals.

 W !!!!,$$REPEAT^XLFSTR("=",80),!!?1,"TOTAL",?10,ACHSCT,?40,$J(ACHSDGT,4)

 S X=ACHSCHBT,X2="2$"

 D COMMA^%DTC

 W ?50,X

 S X=ACHSCHAT,X2="2$"

 D COMMA^%DTC

 W ?65,X

 I ACHSCHBT>0&(ACHSCHAT>0) S X=(ACHSCHAT/ACHSCHBT)*100 W !!?1,"PERCENTAGE OF CHGS ALLOWED TO CHS BILLED" W ?61,$E(X,1,5)_"%"

 W !!?3,"** HOSP - "_ACHS43T_" **",?32,"** DENT - "_ACHS57T_" **",?62,"** OUTP - "_ACHS64T_" **"

 K DIR

 I IOST["C-",'$D(IO("S")) S DIR(0)="E" W !! D ^DIR G END:Y=0

END ;Close device, kill variables, quit

 S:$D(ZTQUEUED) ZTREQ="@"

 D ^%ZISC

 K ACHSPAGE,C,ACHSCHB,ACHSCHA,ACHSDOCS,ACHSCHBS

 K ACHS43,ACHS43S,ACHS43T,ACHS57,ACHS57S,ACHS57T,ACHS64,ACHS64S,ACHS64T

 K ACHSBEG,ACHSCOD,ACHSCODP,ACHSCS,ACHSCT,ACHSEND,Z

 K ACHSDOCT,ACHSDOC,ACHSCODE,ACHSDAT,ACHSTIM,ACHSDGT

 K ACHSQIO,ACHSCHBT,ACHSCHAT,ACHSCHAS,ACHSUSR,ACHSVNDR,I

 K X2,^TMP("ACHSCPT",$J),DIR

 Q

 ;

NODATA ; 

 D HEADER

 S %=$P($G(^AUTTVNDR(ACHSVNDR,0)),U),%=$P(%,",",2)_" "_$P(%,",",1)

 W !!!,$$C^XBFUNC("NO DATA AVAILABLE FOR "_%_" FOR SPECIFIED DATE RANGE",80),!!!!

 I IOST["C-",'$D(IO("S")),'$D(ZTQUEUED) K DIR S DIR(0)="E" U IO(0) D ^DIR K DIR Q:Y=0

 K ^TMP("ACHSCPT",$J,ACHSVNDR,0) S ACHSPAGE=0

 G P1

 ;

NODATA1 ; 

 K DIR

 D HEADER

 S DIR(0)="E"

 W !!!,"NO DATA AVAILABLE FOR SPECIFIED CRITERIA",!!!!

 I IOST["C-",'$D(IO("S")) D ^DIR G END:Y=0

 K DIR,^TMP("ACHSCPT",$J)

 D END

 G ^ACHSCPTD:'$D(ZTQUEUED)

 Q

 ;

HEADER ;Prints heading

 W @IOF

 S ACHSPAGE=ACHSPAGE+1

 S Y=$$HTE^XLFDT($H),ACHSDAT=$P(Y,"@",1),ACHSTIM=$P(Y,"@",2)

 W !,"*",ACHSDAT

 S X=$$LOC^ACHS

 W ?((80/2)-($L(X)/2)),X

 W ?71,ACHSTIM,"*",!,"*User: ",ACHSUSR,?70,"Device:",IO,"*"

 W !!

 S X="CPT CODE Summary Report BY VENDOR - Page "

 W ?((80/2)-($L(X)/2)),X_ACHSPAGE

 W !

 S X="For "_$$FMTE^XLFDT(ACHSBEG)_" To "_$$FMTE^XLFDT(ACHSEND)

 W ?((80/2)-($L(X)/2)),X,!

 W $$REPEAT^XLFSTR("*",80)

 Q

 ;

HEADER1 ;Prints Vendor 

 W !!?23,"Vendor: ",$S($D(^AUTTVNDR(ACHSVNDR,0)):$P($G(^AUTTVNDR(ACHSVNDR,0)),U),1:"NOT ON FILE"),!!?1,"CPTCODE",?40,"# DOCS #",?52,"$ CHG BLD $",?66,"$ CHG ALWD $",!,$$REPEAT^XLFSTR("~",80)

 Q

 ;

ACHSCPTF  ; IHS/ITSC/TPF/PMF - PRINT CHS CPT CODE REPORT-BY VENDOR/SUMMARY ; JUL 10, 2008 

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**14**;JUN 11,2001

 +2       ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES

 +3       ;

 +4        DO BRPT^ACHSFU

 +5        SET (ACHSPAGE,C,ACHSCHBS,ACHSDOCT,ACHSDGT,ACHSDOC,ACHSCHAT,ACHSCHBT,ACHSCHAS,ACHS43S,ACHS43T,ACHS57S,ACHS57T,ACHS64S,ACHS64T,ACHSCS,ACHSCT)=0

 +6        SET ACHSVNDR=""

P1        ; 

 +1        SET ACHSVNDR=$ORDER(^TMP("ACHSCPT",$JOB,ACHSVNDR))

 +2        IF ACHSVNDR=""

               GOTO TOTL

 +3        IF ACHSVNDR=0

               GOTO NODATA1

 +4        IF $DATA(^TMP("ACHSCPT",$JOB,ACHSVNDR,0))

               GOTO NODATA

 +5        SET ACHSCODE=""

 +6        DO HEADER

           DO HEADER1

P2        ; 

 +1        SET ACHSCODE=$ORDER(^TMP("ACHSCPT",$JOB,ACHSVNDR,ACHSCODE))

 +2        IF ACHSCODE=""

               GOTO SUBTOTL

 +3        SET ACHSDOCS=$PIECE($GET(^TMP("ACHSCPT",$JOB,ACHSVNDR,ACHSCODE)),U)

 +4        SET ACHSCHB=$PIECE($GET(^TMP("ACHSCPT",$JOB,ACHSVNDR,ACHSCODE)),U,2)

 +5        SET ACHSCHA=$PIECE($GET(^TMP("ACHSCPT",$JOB,ACHSVNDR,ACHSCODE)),U,3)

 +6       ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 4 LINES

 +7       ;S ACHSCODP=$S($D(^ICPT(ACHSCODE,0)):$P($G(^ICPT(ACHSCODE,0)),U,2),1:"NOT ON FILE")

 +8        SET ACHSCODP=$SELECT($DATA(^ICPT(ACHSCODE,0)):$PIECE($$CPT^ICPTCOD(ACHSCODE),U,3),1:"NOT ON FILE")

 +9       ;S ACHSCOD=$S($D(^ICPT(ACHSCODE,0)):$P($G(^ICPT(ACHSCODE,0)),U),1:ACHSCODE)

 +10       SET ACHSCOD=$SELECT($DATA(^ICPT(ACHSCODE,0)):$PIECE($$CPT^ICPTCOD(ACHSCODE),U,2),1:ACHSCODE)

PRINT     ;Prints data totals

 +1        WRITE !?1,$JUSTIFY(ACHSCOD,6)_"-"_ACHSCODP,?40,$JUSTIFY(ACHSDOCS,4)

 +2        SET X=ACHSCHB

           SET X2=2

 +3        DO COMMA^%DTC

 +4        WRITE ?50,X

 +5        SET X=ACHSCHA

           SET X2=2

 +6        DO COMMA^%DTC

 +7        WRITE ?65,X

 +8        IF IOST["P-"&($Y>56)

               DO HEADER

               DO HEADER1

 +9        IF IOST["C-"

               IF '$DATA(IO("S"))&($Y>24)

                   KILL DIR

                   SET DIR(0)="E"

                   WRITE !!

                   DO ^DIR

                   IF Y=0

                       GOTO END

                   DO HEADER

                   DO HEADER1

 +10       SET Z=$GET(^TMP("ACHSCPT",$JOB,ACHSVNDR,ACHSCODE))

 +11       SET ACHS43=$PIECE(Z,U,4)

           SET ACHS57=$PIECE(Z,U,5)

           SET ACHS64=$PIECE(Z,U,6)

           SET ACHS43S=ACHS43S+ACHS43

           SET ACHS57S=ACHS57S+ACHS57

           SET ACHS64S=ACHS64S+ACHS64

 +12       SET ACHSCHBS=ACHSCHBS+ACHSCHB

           SET ACHSCHAS=ACHSCHAS+ACHSCHA

           SET ACHSDOCT=ACHSDOCT+ACHSDOCS

           SET ACHSCS=ACHSCS+1

 +13       SET (ACHSCHB,ACHSDOCS,ACHSCHA,C)=0

 +14       GOTO P2

 +15      ;

SUBTOTL   ; Print subtotals.

 +1        WRITE !!,$$REPEAT^XLFSTR("-",80),!?1,"SUBTOTAL",?10,ACHSCS,?40,$JUSTIFY(ACHSDOCT,4)

 +2        SET X=ACHSCHBS

           SET X2="2$"

 +3        DO COMMA^%DTC

 +4        WRITE ?50,X

 +5        SET X=ACHSCHAS

           SET X2="2$"

 +6        DO COMMA^%DTC

 +7        WRITE ?65,X

 +8        IF ACHSCHBS>0&(ACHSCHAS>0)

               SET X=(ACHSCHAS/ACHSCHBS)*100

               WRITE !!?1,"PERCENTAGE OF CHGS ALLOWED TO CHGS BILLED"

               WRITE ?61,$EXTRACT(X,1,5)_"%"

 +9        WRITE !!?3,"** HOSP - "_ACHS43S_" **",?32,"** DENT - "_ACHS57S_" **",?62,"** OUTP - "_ACHS64S_" **"

 +10       SET ACHSCHBT=ACHSCHBT+ACHSCHBS

           SET ACHSCHAT=ACHSCHAT+ACHSCHAS

           SET ACHSDGT=ACHSDGT+ACHSDOCT

 +11       SET ACHS43T=ACHS43T+ACHS43S

           SET ACHS57T=ACHS57T+ACHS57S

           SET ACHS64T=ACHS64T+ACHS64S

           SET ACHSCT=ACHSCT+ACHSCS

 +12       KILL DIR

 +13       IF IOST["C-"

               IF '$DATA(IO("S"))

                   SET DIR(0)="E"

                   WRITE !!

                   DO ^DIR

                   IF Y=0

                       GOTO END

 +14       SET (C,ACHSCHBS,ACHSCHAS,ACHSDOCT,ACHSPAGE,ACHS43S,ACHS57S,ACHS64S,ACHSCS)=0

 +15       GOTO P1

 +16      ;

TOTL      ; Print totals.

 +1        WRITE !!!!,$$REPEAT^XLFSTR("=",80),!!?1,"TOTAL",?10,ACHSCT,?40,$JUSTIFY(ACHSDGT,4)

 +2        SET X=ACHSCHBT

           SET X2="2$"

 +3        DO COMMA^%DTC

 +4        WRITE ?50,X

 +5        SET X=ACHSCHAT

           SET X2="2$"

 +6        DO COMMA^%DTC

 +7        WRITE ?65,X

 +8        IF ACHSCHBT>0&(ACHSCHAT>0)

               SET X=(ACHSCHAT/ACHSCHBT)*100

               WRITE !!?1,"PERCENTAGE OF CHGS ALLOWED TO CHS BILLED"

               WRITE ?61,$EXTRACT(X,1,5)_"%"

 +9        WRITE !!?3,"** HOSP - "_ACHS43T_" **",?32,"** DENT - "_ACHS57T_" **",?62,"** OUTP - "_ACHS64T_" **"

 +10       KILL DIR

 +11       IF IOST["C-"

               IF '$DATA(IO("S"))

                   SET DIR(0)="E"

                   WRITE !!

                   DO ^DIR

                   IF Y=0

                       GOTO END

END       ;Close device, kill variables, quit

 +1        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        DO ^%ZISC

 +3        KILL ACHSPAGE,C,ACHSCHB,ACHSCHA,ACHSDOCS,ACHSCHBS

 +4        KILL ACHS43,ACHS43S,ACHS43T,ACHS57,ACHS57S,ACHS57T,ACHS64,ACHS64S,ACHS64T

 +5        KILL ACHSBEG,ACHSCOD,ACHSCODP,ACHSCS,ACHSCT,ACHSEND,Z

 +6        KILL ACHSDOCT,ACHSDOC,ACHSCODE,ACHSDAT,ACHSTIM,ACHSDGT

 +7        KILL ACHSQIO,ACHSCHBT,ACHSCHAT,ACHSCHAS,ACHSUSR,ACHSVNDR,I

 +8        KILL X2,^TMP("ACHSCPT",$JOB),DIR

 +9        QUIT 

 +10      ;

NODATA    ; 

 +1        DO HEADER

 +2        SET %=$PIECE($GET(^AUTTVNDR(ACHSVNDR,0)),U)

           SET %=$PIECE(%,",",2)_" "_$PIECE(%,",",1)

 +3        WRITE !!!,$$C^XBFUNC("NO DATA AVAILABLE FOR "_%_" FOR SPECIFIED DATE RANGE",80),!!!!

 +4        IF IOST["C-"

               IF '$DATA(IO("S"))

                   IF '$DATA(ZTQUEUED)

                       KILL DIR

                       SET DIR(0)="E"

                       USE IO(0)

                       DO ^DIR

                       KILL DIR

                       IF Y=0

                           QUIT 

 +5        KILL ^TMP("ACHSCPT",$JOB,ACHSVNDR,0)

           SET ACHSPAGE=0

 +6        GOTO P1

 +7       ;

NODATA1   ; 

 +1        KILL DIR

 +2        DO HEADER

 +3        SET DIR(0)="E"

 +4        WRITE !!!,"NO DATA AVAILABLE FOR SPECIFIED CRITERIA",!!!!

 +5        IF IOST["C-"

               IF '$DATA(IO("S"))

                   DO ^DIR

                   IF Y=0

                       GOTO END

 +6        KILL DIR,^TMP("ACHSCPT",$JOB)

 +7        DO END

 +8        IF '$DATA(ZTQUEUED)

               GOTO ^ACHSCPTD

 +9        QUIT 

 +10      ;

HEADER    ;Prints heading

 +1        WRITE @IOF

 +2        SET ACHSPAGE=ACHSPAGE+1

 +3        SET Y=$$HTE^XLFDT($HOROLOG)

           SET ACHSDAT=$PIECE(Y,"@",1)

           SET ACHSTIM=$PIECE(Y,"@",2)

 +4        WRITE !,"*",ACHSDAT

 +5        SET X=$$LOC^ACHS

 +6        WRITE ?((80/2)-($LENGTH(X)/2)),X

 +7        WRITE ?71,ACHSTIM,"*",!,"*User: ",ACHSUSR,?70,"Device:",IO,"*"

 +8        WRITE !!

 +9        SET X="CPT CODE Summary Report BY VENDOR - Page "

 +10       WRITE ?((80/2)-($LENGTH(X)/2)),X_ACHSPAGE

 +11       WRITE !

 +12       SET X="For "_$$FMTE^XLFDT(ACHSBEG)_" To "_$$FMTE^XLFDT(ACHSEND)

 +13       WRITE ?((80/2)-($LENGTH(X)/2)),X,!

 +14       WRITE $$REPEAT^XLFSTR("*",80)

 +15       QUIT 

 +16      ;

HEADER1   ;Prints Vendor 

 +1        WRITE !!?23,"Vendor: ",$SELECT($DATA(^AUTTVNDR(ACHSVNDR,0)):$PIECE($GET(^AUTTVNDR(ACHSVNDR,0)),U),1:"NOT ON FILE"),!!?1,"CPTCODE",?40,"# DOCS #",?52,"$ CHG BLD $",?66,"$ CHG ALWD $",!,$$REPEAT^XLFSTR("~",80)

 +2        QUIT 

 +3       ;