ACHSCPTI.m

ACHSCPTI ; IHS/ITSC/TPF/PMF - FOR CHS CPT CODE DETAILED REPORT-HEADER SUBROUTINE ; 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

 ;

HEADER ;EP

 W @IOF

 S ACHSPAGE=ACHSPAGE+1

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

 W !,"*",ACHSDATP

 S X=$$LOC^ACHS

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

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

 W !!

 S X="CPT CODE Detailed Report - BY VENDOR 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,!

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

 Q

 ;

HEADER1 ;EP

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

 W !!?5,"CPT Code: ",ACHSCOD_" - "_ACHSCODP

 W !?7,"Vendor: ",$S($D(^AUTTVNDR(ACHSVNDR,0)):$P($G(^AUTTVNDR(ACHSVNDR,0)),U),1:"NOT ON FILE")

 W !?15,ACHSVADD,!?15,ACHSVCIT," ",?25,ACHSVST," ",?35,ACHSZIP

 W !!,"# DOC #",?12,"SERV",?17,"DOS FROM-DOS TO",?35,"UNITS",?41,"MSG",?45,"TOOTH",?51,"SURF",?56,"$ CHG BLD $",?68,"$ CHG ALWD $"

 W !,$$REPEAT^XLFSTR("~",80)

 Q

 ;

NODATA ;EP

 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")) K DIR S DIR(0)="E" D ^DIR K DIR Q:Y=0

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

 G END

 ;

NODATA1 ;EP

 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

 K ^TMP("ACHSCPT",$J)

 D:$D(IO("S")) ^%ZISC

 G ^ACHSCPTD:'$D(ZTQUEUED)

END ;EP

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

 D ^%ZISC

 K ACHSBEG,ACHSCOD,ACHSCODE,ACHSCODP,ACHSDATP,ACHSEND

 K ACHSFACP,ACHSPAGE,ACHSTIM,ACHSUSR,ACHSVADD,ACHSVCIT,ACHSVNDR

 K ACHSVST,ACHSZIP,I

 Q

 ;

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

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

 +3       ;

HEADER    ;EP

 +1        WRITE @IOF

 +2        SET ACHSPAGE=ACHSPAGE+1

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

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

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

 +4        WRITE !,"*",ACHSDATP

 +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 Detailed Report - BY VENDOR Page "

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

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

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

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

 +14       QUIT 

 +15      ;

HEADER1   ;EP

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

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

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

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

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

 +6        WRITE !!?5,"CPT Code: ",ACHSCOD_" - "_ACHSCODP

 +7        WRITE !?7,"Vendor: ",$SELECT($DATA(^AUTTVNDR(ACHSVNDR,0)):$PIECE($GET(^AUTTVNDR(ACHSVNDR,0)),U),1:"NOT ON FILE")

 +8        WRITE !?15,ACHSVADD,!?15,ACHSVCIT," ",?25,ACHSVST," ",?35,ACHSZIP

 +9        WRITE !!,"# DOC #",?12,"SERV",?17,"DOS FROM-DOS TO",?35,"UNITS",?41,"MSG",?45,"TOOTH",?51,"SURF",?56,"$ CHG BLD $",?68,"$ CHG ALWD $"

 +10       WRITE !,$$REPEAT^XLFSTR("~",80)

 +11       QUIT 

 +12      ;

NODATA    ;EP

 +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"))

                   KILL DIR

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

                   IF Y=0

                       QUIT 

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

 +6        GOTO END

 +7       ;

NODATA1   ;EP

 +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

 +7        KILL ^TMP("ACHSCPT",$JOB)

 +8        IF $DATA(IO("S"))

               DO ^%ZISC

 +9        IF '$DATA(ZTQUEUED)

               GOTO ^ACHSCPTD

END       ;EP

 +1        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        DO ^%ZISC

 +3        KILL ACHSBEG,ACHSCOD,ACHSCODE,ACHSCODP,ACHSDATP,ACHSEND

 +4        KILL ACHSFACP,ACHSPAGE,ACHSTIM,ACHSUSR,ACHSVADD,ACHSVCIT,ACHSVNDR

 +5        KILL ACHSVST,ACHSZIP,I

 +6        QUIT 

 +7       ;