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

ACHSCPTI.m

Go to the documentation of this file.
  1. ACHSCPTI ; IHS/ITSC/TPF/PMF - FOR CHS CPT CODE DETAILED REPORT-HEADER SUBROUTINE ; JUL 10, 2008
  1. ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**14**;JUN 11,2001
  1. ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES
  1. ;
  1. W @IOF
  1. S ACHSPAGE=ACHSPAGE+1
  1. S Y=$$HTE^XLFDT($H),ACHSDATP=$P(Y,"@",1),ACHSTIM=$P(Y,"@",2)
  1. W !,"*",ACHSDATP
  1. S X=$$LOC^ACHS
  1. W ?((80/2)-($L(X)/2)),X
  1. W ?71,ACHSTIM,"*",!,"*User: ",ACHSUSR,?70,"Device:",IO,"*"
  1. W !!
  1. S X="CPT CODE Detailed Report - BY VENDOR 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,!
  1. W $$REPEAT^XLFSTR("*",80)
  1. Q
  1. ;
  1. HEADER1 ;EP
  1. ;3.1*14 12.4.2007 IHS/OIT/FCJ ADDED CSV CHANGES NXT 4 LINES
  1. ;S ACHSCODP=$S($D(^ICPT(ACHSCODE,0)):$P($G(^ICPT(ACHSCODE,0)),U,2),1:"NOT ON FILE")
  1. S ACHSCODP=$S($D(^ICPT(ACHSCODE,0)):$P($$CPT^ICPTCOD(ACHSCODE),U,3),1:"NOT ON FILE")
  1. ;S ACHSCOD=$S($D(^ICPT(ACHSCODE,0)):$P($G(^ICPT(ACHSCODE,0)),U),1:ACHSCODE)
  1. S ACHSCOD=$S($D(^ICPT(ACHSCODE,0)):$P($$CPT^ICPTCOD(ACHSCODE),U,2),1:ACHSCODE)
  1. W !!?5,"CPT Code: ",ACHSCOD_" - "_ACHSCODP
  1. W !?7,"Vendor: ",$S($D(^AUTTVNDR(ACHSVNDR,0)):$P($G(^AUTTVNDR(ACHSVNDR,0)),U),1:"NOT ON FILE")
  1. W !?15,ACHSVADD,!?15,ACHSVCIT," ",?25,ACHSVST," ",?35,ACHSZIP
  1. W !!,"# DOC #",?12,"SERV",?17,"DOS FROM-DOS TO",?35,"UNITS",?41,"MSG",?45,"TOOTH",?51,"SURF",?56,"$ CHG BLD $",?68,"$ CHG ALWD $"
  1. W !,$$REPEAT^XLFSTR("~",80)
  1. Q
  1. ;
  1. NODATA ;EP
  1. D HEADER
  1. S %=$P($G(^AUTTVNDR(ACHSVNDR,0)),U),%=$P(%,",",2)_" "_$P(%,",",1)
  1. W !!!,$$C^XBFUNC("NO DATA AVAILABLE FOR "_%_" FOR SPECIFIED DATE RANGE",80),!!!!
  1. I IOST["C-",'$D(IO("S")) K DIR S DIR(0)="E" D ^DIR K DIR Q:Y=0
  1. K ^TMP("ACHSCPT",$J,ACHSVNDR,0)
  1. G END
  1. ;
  1. NODATA1 ;EP
  1. K DIR
  1. D HEADER
  1. S DIR(0)="E"
  1. W !!!,"NO DATA AVAILABLE FOR SPECIFIED CRITERIA",!!!!
  1. I IOST["C-",'$D(IO("S")) D ^DIR G END:Y=0
  1. K DIR
  1. K ^TMP("ACHSCPT",$J)
  1. D:$D(IO("S")) ^%ZISC
  1. G ^ACHSCPTD:'$D(ZTQUEUED)
  1. END ;EP
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. D ^%ZISC
  1. K ACHSBEG,ACHSCOD,ACHSCODE,ACHSCODP,ACHSDATP,ACHSEND
  1. K ACHSFACP,ACHSPAGE,ACHSTIM,ACHSUSR,ACHSVADD,ACHSVCIT,ACHSVNDR
  1. K ACHSVST,ACHSZIP,I
  1. Q
  1. ;