Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSCPTC

ACHSCPTC.m

Go to the documentation of this file. 
  1. 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
  1.  ;ITSC/SET/JVK ACHS*3.1*7 8/27/2003 - MODIFIED TO GET CODE NOT IEN 
  1.  ;ACHS*3.1*13 IHS/SET/JVK FIX $O 10/14/05
  1.  ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES
  1.  ;
  1.  D BRPT^ACHSFU
  1.  S (ACHSDOC,ACHSDST)=0
  1.  S (ACHSPAGE,ACHSCS,ACHSCT,ACHSCHAS,ACHSDOCS,ACHSCHBS,ACHSCHAT,ACHSCHBT,ACHSDOCT,ACHS43S,ACHS43T,ACHS57S,ACHS57T,ACHS64S,ACHS64T)=0
  1.  S ACHSVNDR=""
  1. P1 ;
  1.  S ACHSVNDR=$O(^TMP("ACHSCPT",$J,ACHSVNDR))
  1.  G:ACHSVNDR="" TOTAL
  1.  S ACHSCODE=""
  1.  I $D(^TMP("ACHSCPT",$J,ACHSVNDR,0)) S C=0 G NODATA
  1.  D HEADER
  1. P1A ;
  1.  S ACHSCODE=$O(^TMP("ACHSCPT",$J,ACHSVNDR,ACHSCODE))
  1.  G:ACHSCODE="" SUBTOTL
  1.  S ACHSDOCS=$P($G(^TMP("ACHSCPT",$J,ACHSVNDR,ACHSCODE)),U)
  1.  S ACHSCHB=$P($G(^TMP("ACHSCPT",$J,ACHSVNDR,ACHSCODE)),U,2)
  1.  S ACHSCHA=$P($G(^TMP("ACHSCPT",$J,ACHSVNDR,ACHSCODE)),U,3)
  1.  ;IHS/SET/JVK ACHS*3.1*7
  1.  ;S ACHSCODP=$S($D(^ICPT(ACHSCODE,0)):$P($G(^ICPT(ACHSCODE,0)),U,2),1:"NOT ON FILE")
  1.  ;ACHS*3.1*13 IHS/SET/JVK COMMENT BELOW ADD $J FOLLOWING LINE 10/14/05
  1.  ;S ACHSDCPT="" S ACHSDCPT=$O(^TMP("ACHSINDX",ACHSCODE,ACHSDCPT))
  1.  S ACHSDCPT="" S ACHSDCPT=$O(^TMP("ACHSINDX",$J,ACHSCODE,ACHSDCPT))
  1.  ;3.1*14 12.13.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
  1.  ;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")
  1.  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")
  1.  ;S ACHSCOD=$S($D(^ICPT(ACHSCODE,0)):$P($G(^ICPT(ACHSCODE,0)),U,1),1:ACHSCODE)
  1.  ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 2 LINES
  1.  ;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")
  1.  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")
  1.  ;Prints data totals
  1.  ;ITSC/SET/JVK ACHS*3.1*7
  1.  ;W !?1,$J(ACHSCOD,6)_" - "_ACHSCODP,?40,$J(ACHSDOCS,4)
  1.  W !?1,$J(ACHSCOD,6)_" - "_$J($E(ACHSCODP,1,30),30),?40,$J(ACHSDOCS,4)
  1.  S X=ACHSCHB,X2=2
  1.  D COMMA^%DTC
  1.  W ?51,X
  1.  S X=ACHSCHA,X2=2
  1.  D COMMA^%DTC
  1.  W ?66,X
  1.  I IOST["P-"&($Y>56) D HEADER,HEADER1
  1.  I IOST["C-",'$D(IO("S"))&($Y>24) K DIR S DIR(0)="E" W !! D ^DIR G END:Y=0 D HEADER,HEADER1
  1.  S ACHSCHBS=ACHSCHBS+ACHSCHB,ACHSCHAS=ACHSCHAS+ACHSCHA,ACHSDST=ACHSDST+ACHSDOCS,ACHSCS=ACHSCS+1
  1.  S Z=$G(^TMP("ACHSCPT",$J,ACHSVNDR,ACHSCODE))
  1.  S ACHS43=$P(Z,U,4),ACHS57=$P(Z,U,5),ACHS64=$P(Z,U,6)
  1.  S ACHS43S=ACHS43S+ACHS43,ACHS57S=ACHS57S+ACHS57,ACHS64S=ACHS64S+ACHS64
  1.  G P1A
  1.  ;
  1. SUBTOTL ;
  1.  W !!,$$REPEAT^XLFSTR("-",80),!,"SUBTOTAL",?10,ACHSCS,?40,$J(ACHSDST,4)
  1.  S X=ACHSCHBS,X2="2$"
  1.  D COMMA^%DTC
  1.  W ?51,X
  1.  S X=ACHSCHAS,X2="2$"
  1.  D COMMA^%DTC
  1.  W ?66,X
  1.  I ACHSCHBS>0&(ACHSCHAS>0) W !! S X=(ACHSCHAS/ACHSCHBS)*100 W "PERCENTAGE OF CHGS ALLOWED TO CHGS BILLED",?64,$E(X,1,5)_"%"
  1.  W !!?3,"** HOSP - "_ACHS43S_" **",?32,"** DENT - "_ACHS57S_" **",?62,"** OUTP - "_ACHS64S_" **"
  1.  S ACHSCHBT=ACHSCHBT+ACHSCHBS,ACHSCHAT=ACHSCHAT+ACHSCHAS,ACHSDOCT=ACHSDOCT+ACHSDST,ACHSCT=ACHSCT+ACHSCS
  1.  S ACHS43T=ACHS43T+ACHS43S,ACHS57T=ACHS57T+ACHS57S,ACHS64T=ACHS64T+ACHS64S
  1.  K DIR
  1.  I IOST["C-",'$D(IO("S")) S DIR(0)="E" W !! D ^DIR G END:Y=0
  1.  S (ACHSCHBS,ACHSCHAS,ACHSDST,ACHSPAGE,ACHSCS,ACHS43S,ACHS57S,ACHS64S)=0
  1.  G P1
  1.  ;
  1. TOTAL ;
  1.  W !!!!,$$REPEAT^XLFSTR("=",80),!!,"TOTAL",?10,ACHSCT,?40,$J(ACHSDOCT,4)
  1.  S X=ACHSCHBT,X2="2$"
  1.  D COMMA^%DTC
  1.  W ?51,X
  1.  S X=ACHSCHAT,X2="2$"
  1.  D COMMA^%DTC
  1.  W ?66,X,!
  1.  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)_"%"
  1.  W !!?3,"** HOSP - "_ACHS43T_" **",?32,"** DENT - "_ACHS57T_" **",?62,"** OUTP - "_ACHS64T_" **"
  1.  K DIR
  1.  I IOST["C-",'$D(IO("S")) S DIR(0)="E" W !! D ^DIR G END:Y=0
  1. END ;Close device, kill variables, quit
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  D ^%ZISC
  1.  K ACHSDOC,ACHSPAGE,C,ACHSDOCS,ACHS43,ACHS43S,ACHS43T,ACHS57,ACHS57S
  1.  K ACHSDOCT,ACHSDOC,ACHSDAT,ACHSTIM,ACHSVNDR,I,X,ACHS57T,ACHS64
  1.  K ACHSDST,ACHSUSR,^TMP("ACHSCPT",$J),X2,Y,ACHS64S,ACHS64T,ACHSBEG
  1.  K ACHSCHA,ACHSCHAS,ACHSCHAT,ACHSCHB,ACHSCHBS,ACHSCHBT,ACHSCOD
  1.  K ACHSCODE,ACHSCODP,ACHSCS,ACHSCT,ACHSEND,ACHSQIO,Z,DIR
  1.  Q
  1.  ;
  1. NODATA ;
  1.  K DIR
  1.  S DIR(0)="E"
  1.  D HEADER
  1.  W !!!,"NO DATA AVAILABLE FOR SPECIFIED CRITERIA",!!!!
  1.  I IOST["C-",'$D(IO("S")) D ^DIR Q:Y=0
  1.  K DIR,^TMP("ACHSCPT",$J,ACHSVNDR,0)
  1.  S ACHSPAGE=0
  1.  G P1
  1.  ;
  1.  W @IOF
  1.  S ACHSPAGE=ACHSPAGE+1
  1.  S Y=$$HTE^XLFDT($H),ACHSDAT=$P(Y,"@",1),ACHSTIM=$P(Y,"@",2)
  1.  W !,"*",ACHSDAT
  1.  S X=$$LOC^ACHS
  1.  W ?((80/2)-($L(X)/2)),X,?71,ACHSTIM,"*",!,"*User: ",ACHSUSR,?70,"Device:",IO,"*",!!
  1.  S X="CPT CODE Summary Report - Page "
  1.  W ?((80/2)-($L(X)/2)),X_ACHSPAGE
  1.  S X="For "_$$FMTE^XLFDT(ACHSBEG)_" To "_$$FMTE^XLFDT(ACHSEND)
  1.  W !?((80/2)-($L(X)/2)),X,!,$$REPEAT^XLFSTR("*",80)
  1. HEADER1 ;
  1.  W !!?1,"CPTCODE",?40,"# DOCS #",?52,"$ CHG BLD $",?66,"$ CHG ALWD $",!,$$REPEAT^XLFSTR("~",80)
  1.  Q