| [613] | 1 | FBAASOUT ;AISC/DMK-OUTPUT FOR CPT FEE SCHEDULE ;4/17/2000
|
|---|
| 2 | ;;3.5;FEE BASIS;**1,4,21**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ASKDT S %DT="AE",%DT("A")="Select Fiscal Year: " D ^%DT K %DT("A") G END:Y<0 S FBFY=$S('$E(Y,4,7):($E(Y,1,3)+1700),$E(Y,4,5)>9:($E(Y,1,3)+1701),1:($E(Y,1,3)+1700)) I '$D(^FBAA(163.99,"AC",FBFY)) G HELP
|
|---|
| 5 | S VAR="FBFY",VAL=FBFY,PGM="START^FBAASOUT" D ZIS^FBAAUTL G:FBPOP END
|
|---|
| 6 | ;
|
|---|
| 7 | START S FBAAOUT=0,FBPAGE=1,FBDASH=$$REPEAT^XLFSTR("-",80)
|
|---|
| 8 | K ^TMP("FBCPT",$J)
|
|---|
| 9 | U IO W:$E(IOST,1,2)["C-" @IOF D HEAD
|
|---|
| 10 | ;locate schedule for selected fiscal year and set in ^TMP for sort
|
|---|
| 11 | S I=0 F S I=$O(^FBAA(163.99,I)) Q:'I!(FBAAOUT) I $D(^FBAA(163.99,I,"FY",FBFY)) S FBY(0)=^(FBFY,0),FBCPT=$P($G(^FBAA(163.99,I,0)),U) D:FBCPT]""
|
|---|
| 12 | . S ^TMP("FBCPT",$J,1_$P(FBCPT,"-"),$S(FBCPT'["-":0,1:$P(FBCPT,"-",2)))=FBY(0)
|
|---|
| 13 | ;go through TMP and print out in cpt order
|
|---|
| 14 | S FBI=0,FBJ=""
|
|---|
| 15 | F S FBI=$O(^TMP("FBCPT",$J,FBI)) Q:FBI']""!($G(FBAAOUT)) F S FBJ=$O(^TMP("FBCPT",$J,FBI,FBJ)) Q:FBJ=""!($G(FBAAOUT)) S FBY(0)=^(FBJ),FBCPT=$E(FBI,2,99)_$S(FBJ=0:"",1:"-"_FBJ) D PRINT
|
|---|
| 16 | D END Q
|
|---|
| 17 | ;
|
|---|
| 18 | PRINT I $Y+5>IOSL D HANG^FBAAUTL1:$E(IOST,1,2)["C-" Q:FBAAOUT W @IOF S FBPAGE=FBPAGE+1 D HEAD
|
|---|
| 19 | F FBY=1,2,5,6,7,8 S FBY(FBY)=$P(FBY(0),"^",FBY)
|
|---|
| 20 | I $E(FBY(7),6,7)="00" S FBY(7)=$E(FBY(7),1,5)_"01"
|
|---|
| 21 | F K=6,7,8 S FBY(K)=$$DATX^FBAAUTL($P(FBY(K),"."))
|
|---|
| 22 | W !,FBCPT,?12,FBY(2),?26,$J(FBY(5),1,2),?42,FBY(6),?60,$S(FBY(7)]"":FBY(7)_" - "_FBY(8),1:" Add/Edit")
|
|---|
| 23 | W !,?2,$E($P($$CPT^ICPTCOD($P(FBCPT,"-"),"",1),U,3),1,39)
|
|---|
| 24 | I $P(FBCPT,"-",2)]"" D Q:FBAAOUT
|
|---|
| 25 | . N FBI,FBMOD,FBMODX,FBPOS
|
|---|
| 26 | . S FBPOS=$L($E($P($$CPT^ICPTCOD($P(FBCPT,"-"),"",1),U,3),1,39))+2
|
|---|
| 27 | . F FBI=1:1 S FBMOD=$P($P(FBCPT,"-",2),",",FBI) Q:FBMOD="" D Q:FBAAOUT
|
|---|
| 28 | . . I $Y+5>IOSL D HANG^FBAAUTL1:$E(IOST,1,2)="C-" Q:FBAAOUT W @IOF S FBPAGE=FBPAGE+1 D HEAD W " continued"
|
|---|
| 29 | . . W ?FBPOS,"-"
|
|---|
| 30 | . . S FBMODX=$$MOD^ICPTMOD(FBMOD,"E")
|
|---|
| 31 | . . ; if modifier data not obtained then try another API to resolve it
|
|---|
| 32 | . . ; since there can be duplicate modifiers with same external value
|
|---|
| 33 | . . I $P(FBMODX,U)'>0 D
|
|---|
| 34 | . . . N FBY
|
|---|
| 35 | . . . S FBY=$$MODP^ICPTMOD($P(FBCPT,"-"),FBMOD,"E")
|
|---|
| 36 | . . . I $P(FBY,U)>0 S FBMODX=$$MOD^ICPTMOD($P(FBY,U),"I")
|
|---|
| 37 | . . W $E($S($P(FBMODX,U)>0:$P(FBMODX,U,3),1:FBMOD),1,36),!
|
|---|
| 38 | E W !
|
|---|
| 39 | W FBDASH
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | HEAD W !!,?19,"**** REPORT OF FEE SCHEDULE ****",!!,?26,"For Fiscal Year ",FBFY,?70,"Page ",$G(FBPAGE),!!,$$REPEAT^XLFSTR("=",80)
|
|---|
| 43 | W !!,"CPT-MOD",?10,"Total #",?25,"75 %ile",?40,"Date Compiled",?65,"Date Range ",!,?2,"Description",!,$$REPEAT^XLFSTR("=",80),!
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | END K DIRUT,DUOUT,DTOUT,FBCPT,FBAAOUT,FBFY,FBI,FBJ,FBPAGE,FBY,I,K,PGM,Q,QQ,VAL,VAR,X,Y,FBDESC,^TMP("FBCPT",$J),FBDASH
|
|---|
| 47 | D CLOSE^FBAAUTL
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | HELP W *7,!!,"There is no data on file for fiscal year ",FBFY,! G ASKDT
|
|---|
