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
;
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
;
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 ;
+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 ;
+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 ;
