ACHSCPTC ; IHS/ITSC/PMF - PRINT CHS CPT CODES REPORT-SUMMARY ONLY ;JUL 10, 2008
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**7,13,14**;JUN 11,2001
;ITSC/SET/JVK ACHS*3.1*7 8/27/2003 - MODIFIED TO GET CODE NOT IEN
;ACHS*3.1*13 IHS/SET/JVK FIX $O 10/14/05
;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES
;
D BRPT^ACHSFU
S (ACHSDOC,ACHSDST)=0
S (ACHSPAGE,ACHSCS,ACHSCT,ACHSCHAS,ACHSDOCS,ACHSCHBS,ACHSCHAT,ACHSCHBT,ACHSDOCT,ACHS43S,ACHS43T,ACHS57S,ACHS57T,ACHS64S,ACHS64T)=0
S ACHSVNDR=""
P1 ;
S ACHSVNDR=$O(^TMP("ACHSCPT",$J,ACHSVNDR))
G:ACHSVNDR="" TOTAL
S ACHSCODE=""
I $D(^TMP("ACHSCPT",$J,ACHSVNDR,0)) S C=0 G NODATA
D HEADER
P1A ;
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)
;IHS/SET/JVK ACHS*3.1*7
;S ACHSCODP=$S($D(^ICPT(ACHSCODE,0)):$P($G(^ICPT(ACHSCODE,0)),U,2),1:"NOT ON FILE")
;ACHS*3.1*13 IHS/SET/JVK COMMENT BELOW ADD $J FOLLOWING LINE 10/14/05
;S ACHSDCPT="" S ACHSDCPT=$O(^TMP("ACHSINDX",ACHSCODE,ACHSDCPT))
S ACHSDCPT="" S ACHSDCPT=$O(^TMP("ACHSINDX",$J,ACHSCODE,ACHSDCPT))
;3.1*14 12.13.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
;S ACHSCODP=$S(ACHSDCPT["ICPT":$P($G(^ICPT(ACHSCODE,0)),U,2),ACHSDCPT["AUTTREVN":$P($G(^AUTTREVN(ACHSCODE,0)),U,2),ACHSDCPT["AUTTADA":$P($G(^AUTTADA(ACHSCODE,0)),U,2),1:"NOT ON FILE")
S ACHSCODP=$S(ACHSDCPT["ICPT":$P($$CPT^ICPTCOD(ACHSCODE),U,3),ACHSDCPT["AUTTREVN":$P($G(^AUTTREVN(ACHSCODE,0)),U,2),ACHSDCPT["AUTTADA":$P($G(^AUTTADA(ACHSCODE,0)),U,2),1:"NOT ON FILE")
;S ACHSCOD=$S($D(^ICPT(ACHSCODE,0)):$P($G(^ICPT(ACHSCODE,0)),U,1),1:ACHSCODE)
;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
;S ACHSCOD=$S(ACHSDCPT["ICPT":$P($G(^ICPT(ACHSCODE,0)),U,1),ACHSDCPT["AUTTREVN":$P($G(^AUTTREVN(ACHSCODE,0)),U,1),ACHSDCPT["AUTTADA":$P($G(^AUTTADA(ACHSCODE,0)),U,1),1:"NOT ON FILE")
S ACHSCOD=$S(ACHSDCPT["ICPT":$P($$CPT^ICPTCOD(ACHSCODE),U,2),ACHSDCPT["AUTTREVN":$P($G(^AUTTREVN(ACHSCODE,0)),U,1),ACHSDCPT["AUTTADA":$P($G(^AUTTADA(ACHSCODE,0)),U,1),1:"NOT ON FILE")
;Prints data totals
;ITSC/SET/JVK ACHS*3.1*7
;W !?1,$J(ACHSCOD,6)_" - "_ACHSCODP,?40,$J(ACHSDOCS,4)
W !?1,$J(ACHSCOD,6)_" - "_$J($E(ACHSCODP,1,30),30),?40,$J(ACHSDOCS,4)
S X=ACHSCHB,X2=2
D COMMA^%DTC
W ?51,X
S X=ACHSCHA,X2=2
D COMMA^%DTC
W ?66,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 ACHSCHBS=ACHSCHBS+ACHSCHB,ACHSCHAS=ACHSCHAS+ACHSCHA,ACHSDST=ACHSDST+ACHSDOCS,ACHSCS=ACHSCS+1
S Z=$G(^TMP("ACHSCPT",$J,ACHSVNDR,ACHSCODE))
S ACHS43=$P(Z,U,4),ACHS57=$P(Z,U,5),ACHS64=$P(Z,U,6)
S ACHS43S=ACHS43S+ACHS43,ACHS57S=ACHS57S+ACHS57,ACHS64S=ACHS64S+ACHS64
G P1A
;
SUBTOTL ;
W !!,$$REPEAT^XLFSTR("-",80),!,"SUBTOTAL",?10,ACHSCS,?40,$J(ACHSDST,4)
S X=ACHSCHBS,X2="2$"
D COMMA^%DTC
W ?51,X
S X=ACHSCHAS,X2="2$"
D COMMA^%DTC
W ?66,X
I ACHSCHBS>0&(ACHSCHAS>0) W !! S X=(ACHSCHAS/ACHSCHBS)*100 W "PERCENTAGE OF CHGS ALLOWED TO CHGS BILLED",?64,$E(X,1,5)_"%"
W !!?3,"** HOSP - "_ACHS43S_" **",?32,"** DENT - "_ACHS57S_" **",?62,"** OUTP - "_ACHS64S_" **"
S ACHSCHBT=ACHSCHBT+ACHSCHBS,ACHSCHAT=ACHSCHAT+ACHSCHAS,ACHSDOCT=ACHSDOCT+ACHSDST,ACHSCT=ACHSCT+ACHSCS
S ACHS43T=ACHS43T+ACHS43S,ACHS57T=ACHS57T+ACHS57S,ACHS64T=ACHS64T+ACHS64S
K DIR
I IOST["C-",'$D(IO("S")) S DIR(0)="E" W !! D ^DIR G END:Y=0
S (ACHSCHBS,ACHSCHAS,ACHSDST,ACHSPAGE,ACHSCS,ACHS43S,ACHS57S,ACHS64S)=0
G P1
;
TOTAL ;
W !!!!,$$REPEAT^XLFSTR("=",80),!!,"TOTAL",?10,ACHSCT,?40,$J(ACHSDOCT,4)
S X=ACHSCHBT,X2="2$"
D COMMA^%DTC
W ?51,X
S X=ACHSCHAT,X2="2$"
D COMMA^%DTC
W ?66,X,!
I ACHSCHBT>0&(ACHSCHAT>0) W ! S Z=(ACHSCHAT/ACHSCHBT)*100 W "PERCENTAGE OF CHGS ALLOWED TO CHGS BILLED" W ?64,$E(Z,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 ACHSDOC,ACHSPAGE,C,ACHSDOCS,ACHS43,ACHS43S,ACHS43T,ACHS57,ACHS57S
K ACHSDOCT,ACHSDOC,ACHSDAT,ACHSTIM,ACHSVNDR,I,X,ACHS57T,ACHS64
K ACHSDST,ACHSUSR,^TMP("ACHSCPT",$J),X2,Y,ACHS64S,ACHS64T,ACHSBEG
K ACHSCHA,ACHSCHAS,ACHSCHAT,ACHSCHB,ACHSCHBS,ACHSCHBT,ACHSCOD
K ACHSCODE,ACHSCODP,ACHSCS,ACHSCT,ACHSEND,ACHSQIO,Z,DIR
Q
;
NODATA ;
K DIR
S DIR(0)="E"
D HEADER
W !!!,"NO DATA AVAILABLE FOR SPECIFIED CRITERIA",!!!!
I IOST["C-",'$D(IO("S")) D ^DIR Q:Y=0
K DIR,^TMP("ACHSCPT",$J,ACHSVNDR,0)
S ACHSPAGE=0
G P1
;
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,?71,ACHSTIM,"*",!,"*User: ",ACHSUSR,?70,"Device:",IO,"*",!!
S X="CPT CODE Summary Report - Page "
W ?((80/2)-($L(X)/2)),X_ACHSPAGE
S X="For "_$$FMTE^XLFDT(ACHSBEG)_" To "_$$FMTE^XLFDT(ACHSEND)
W !?((80/2)-($L(X)/2)),X,!,$$REPEAT^XLFSTR("*",80)
W !!?1,"CPTCODE",?40,"# DOCS #",?52,"$ CHG BLD $",?66,"$ CHG ALWD $",!,$$REPEAT^XLFSTR("~",80)
Q
ACHSCPTC ; IHS/ITSC/PMF - PRINT CHS CPT CODES REPORT-SUMMARY ONLY ;JUL 10, 2008
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**7,13,14**;JUN 11,2001
+2 ;ITSC/SET/JVK ACHS*3.1*7 8/27/2003 - MODIFIED TO GET CODE NOT IEN
+3 ;ACHS*3.1*13 IHS/SET/JVK FIX $O 10/14/05
+4 ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES
+5 ;
+6 DO BRPT^ACHSFU
+7 SET (ACHSDOC,ACHSDST)=0
+8 SET (ACHSPAGE,ACHSCS,ACHSCT,ACHSCHAS,ACHSDOCS,ACHSCHBS,ACHSCHAT,ACHSCHBT,ACHSDOCT,ACHS43S,ACHS43T,ACHS57S,ACHS57T,ACHS64S,ACHS64T)=0
+9 SET ACHSVNDR=""
P1 ;
+1 SET ACHSVNDR=$ORDER(^TMP("ACHSCPT",$JOB,ACHSVNDR))
+2 IF ACHSVNDR=""
GOTO TOTAL
+3 SET ACHSCODE=""
+4 IF $DATA(^TMP("ACHSCPT",$JOB,ACHSVNDR,0))
SET C=0
GOTO NODATA
+5 DO HEADER
P1A ;
+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 ;IHS/SET/JVK ACHS*3.1*7
+7 ;S ACHSCODP=$S($D(^ICPT(ACHSCODE,0)):$P($G(^ICPT(ACHSCODE,0)),U,2),1:"NOT ON FILE")
+8 ;ACHS*3.1*13 IHS/SET/JVK COMMENT BELOW ADD $J FOLLOWING LINE 10/14/05
+9 ;S ACHSDCPT="" S ACHSDCPT=$O(^TMP("ACHSINDX",ACHSCODE,ACHSDCPT))
+10 SET ACHSDCPT=""
SET ACHSDCPT=$ORDER(^TMP("ACHSINDX",$JOB,ACHSCODE,ACHSDCPT))
+11 ;3.1*14 12.13.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
+12 ;S ACHSCODP=$S(ACHSDCPT["ICPT":$P($G(^ICPT(ACHSCODE,0)),U,2),ACHSDCPT["AUTTREVN":$P($G(^AUTTREVN(ACHSCODE,0)),U,2),ACHSDCPT["AUTTADA":$P($G(^AUTTADA(ACHSCODE,0)),U,2),1:"NOT ON FILE")
+13 SET ACHSCODP=$SELECT(ACHSDCPT["ICPT":$PIECE($$CPT^ICPTCOD(ACHSCODE),U,3),ACHSDCPT["AUTTREVN":$PIECE($GET(^AUTTREVN(ACHSCODE,0)),U,2),ACHSDCPT["AUTTADA":$PIECE($GET(^AUTTADA(ACHSCODE,0)),U,2),1:"NOT ON FILE")
+14 ;S ACHSCOD=$S($D(^ICPT(ACHSCODE,0)):$P($G(^ICPT(ACHSCODE,0)),U,1),1:ACHSCODE)
+15 ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
+16 ;S ACHSCOD=$S(ACHSDCPT["ICPT":$P($G(^ICPT(ACHSCODE,0)),U,1),ACHSDCPT["AUTTREVN":$P($G(^AUTTREVN(ACHSCODE,0)),U,1),ACHSDCPT["AUTTADA":$P($G(^AUTTADA(ACHSCODE,0)),U,1),1:"NOT ON FILE")
+17 SET ACHSCOD=$SELECT(ACHSDCPT["ICPT":$PIECE($$CPT^ICPTCOD(ACHSCODE),U,2),ACHSDCPT["AUTTREVN":$PIECE($GET(^AUTTREVN(ACHSCODE,0)),U,1),ACHSDCPT["AUTTADA":$PIECE($GET(^AUTTADA(ACHSCODE,0)),U,1),1:"NOT ON FILE")
+18 ;Prints data totals
+19 ;ITSC/SET/JVK ACHS*3.1*7
+20 ;W !?1,$J(ACHSCOD,6)_" - "_ACHSCODP,?40,$J(ACHSDOCS,4)
+21 WRITE !?1,$JUSTIFY(ACHSCOD,6)_" - "_$JUSTIFY($EXTRACT(ACHSCODP,1,30),30),?40,$JUSTIFY(ACHSDOCS,4)
+22 SET X=ACHSCHB
SET X2=2
+23 DO COMMA^%DTC
+24 WRITE ?51,X
+25 SET X=ACHSCHA
SET X2=2
+26 DO COMMA^%DTC
+27 WRITE ?66,X
+28 IF IOST["P-"&($Y>56)
DO HEADER
DO HEADER1
+29 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
+30 SET ACHSCHBS=ACHSCHBS+ACHSCHB
SET ACHSCHAS=ACHSCHAS+ACHSCHA
SET ACHSDST=ACHSDST+ACHSDOCS
SET ACHSCS=ACHSCS+1
+31 SET Z=$GET(^TMP("ACHSCPT",$JOB,ACHSVNDR,ACHSCODE))
+32 SET ACHS43=$PIECE(Z,U,4)
SET ACHS57=$PIECE(Z,U,5)
SET ACHS64=$PIECE(Z,U,6)
+33 SET ACHS43S=ACHS43S+ACHS43
SET ACHS57S=ACHS57S+ACHS57
SET ACHS64S=ACHS64S+ACHS64
+34 GOTO P1A
+35 ;
SUBTOTL ;
+1 WRITE !!,$$REPEAT^XLFSTR("-",80),!,"SUBTOTAL",?10,ACHSCS,?40,$JUSTIFY(ACHSDST,4)
+2 SET X=ACHSCHBS
SET X2="2$"
+3 DO COMMA^%DTC
+4 WRITE ?51,X
+5 SET X=ACHSCHAS
SET X2="2$"
+6 DO COMMA^%DTC
+7 WRITE ?66,X
+8 IF ACHSCHBS>0&(ACHSCHAS>0)
WRITE !!
SET X=(ACHSCHAS/ACHSCHBS)*100
WRITE "PERCENTAGE OF CHGS ALLOWED TO CHGS BILLED",?64,$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 ACHSDOCT=ACHSDOCT+ACHSDST
SET ACHSCT=ACHSCT+ACHSCS
+11 SET ACHS43T=ACHS43T+ACHS43S
SET ACHS57T=ACHS57T+ACHS57S
SET ACHS64T=ACHS64T+ACHS64S
+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 (ACHSCHBS,ACHSCHAS,ACHSDST,ACHSPAGE,ACHSCS,ACHS43S,ACHS57S,ACHS64S)=0
+15 GOTO P1
+16 ;
TOTAL ;
+1 WRITE !!!!,$$REPEAT^XLFSTR("=",80),!!,"TOTAL",?10,ACHSCT,?40,$JUSTIFY(ACHSDOCT,4)
+2 SET X=ACHSCHBT
SET X2="2$"
+3 DO COMMA^%DTC
+4 WRITE ?51,X
+5 SET X=ACHSCHAT
SET X2="2$"
+6 DO COMMA^%DTC
+7 WRITE ?66,X,!
+8 IF ACHSCHBT>0&(ACHSCHAT>0)
WRITE !
SET Z=(ACHSCHAT/ACHSCHBT)*100
WRITE "PERCENTAGE OF CHGS ALLOWED TO CHGS BILLED"
WRITE ?64,$EXTRACT(Z,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 ACHSDOC,ACHSPAGE,C,ACHSDOCS,ACHS43,ACHS43S,ACHS43T,ACHS57,ACHS57S
+4 KILL ACHSDOCT,ACHSDOC,ACHSDAT,ACHSTIM,ACHSVNDR,I,X,ACHS57T,ACHS64
+5 KILL ACHSDST,ACHSUSR,^TMP("ACHSCPT",$JOB),X2,Y,ACHS64S,ACHS64T,ACHSBEG
+6 KILL ACHSCHA,ACHSCHAS,ACHSCHAT,ACHSCHB,ACHSCHBS,ACHSCHBT,ACHSCOD
+7 KILL ACHSCODE,ACHSCODP,ACHSCS,ACHSCT,ACHSEND,ACHSQIO,Z,DIR
+8 QUIT
+9 ;
NODATA ;
+1 KILL DIR
+2 SET DIR(0)="E"
+3 DO HEADER
+4 WRITE !!!,"NO DATA AVAILABLE FOR SPECIFIED CRITERIA",!!!!
+5 IF IOST["C-"
IF '$DATA(IO("S"))
DO ^DIR
IF Y=0
QUIT
+6 KILL DIR,^TMP("ACHSCPT",$JOB,ACHSVNDR,0)
+7 SET ACHSPAGE=0
+8 GOTO P1
+9 ;
+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,?71,ACHSTIM,"*",!,"*User: ",ACHSUSR,?70,"Device:",IO,"*",!!
+7 SET X="CPT CODE Summary Report - Page "
+8 WRITE ?((80/2)-($LENGTH(X)/2)),X_ACHSPAGE
+9 SET X="For "_$$FMTE^XLFDT(ACHSBEG)_" To "_$$FMTE^XLFDT(ACHSEND)
+10 WRITE !?((80/2)-($LENGTH(X)/2)),X,!,$$REPEAT^XLFSTR("*",80)
+1 WRITE !!?1,"CPTCODE",?40,"# DOCS #",?52,"$ CHG BLD $",?66,"$ CHG ALWD $",!,$$REPEAT^XLFSTR("~",80)
+2 QUIT
