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