51 lines
2.7 KiB
Mathematica
51 lines
2.7 KiB
Mathematica
FBAASOUT ;AISC/DMK-OUTPUT FOR CPT FEE SCHEDULE ;4/17/2000
|
|
;;3.5;FEE BASIS;**1,4,21**;JAN 30, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
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
|
|
S VAR="FBFY",VAL=FBFY,PGM="START^FBAASOUT" D ZIS^FBAAUTL G:FBPOP END
|
|
;
|
|
START S FBAAOUT=0,FBPAGE=1,FBDASH=$$REPEAT^XLFSTR("-",80)
|
|
K ^TMP("FBCPT",$J)
|
|
U IO W:$E(IOST,1,2)["C-" @IOF D HEAD
|
|
;locate schedule for selected fiscal year and set in ^TMP for sort
|
|
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]""
|
|
. S ^TMP("FBCPT",$J,1_$P(FBCPT,"-"),$S(FBCPT'["-":0,1:$P(FBCPT,"-",2)))=FBY(0)
|
|
;go through TMP and print out in cpt order
|
|
S FBI=0,FBJ=""
|
|
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
|
|
D END Q
|
|
;
|
|
PRINT I $Y+5>IOSL D HANG^FBAAUTL1:$E(IOST,1,2)["C-" Q:FBAAOUT W @IOF S FBPAGE=FBPAGE+1 D HEAD
|
|
F FBY=1,2,5,6,7,8 S FBY(FBY)=$P(FBY(0),"^",FBY)
|
|
I $E(FBY(7),6,7)="00" S FBY(7)=$E(FBY(7),1,5)_"01"
|
|
F K=6,7,8 S FBY(K)=$$DATX^FBAAUTL($P(FBY(K),"."))
|
|
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")
|
|
W !,?2,$E($P($$CPT^ICPTCOD($P(FBCPT,"-"),"",1),U,3),1,39)
|
|
I $P(FBCPT,"-",2)]"" D Q:FBAAOUT
|
|
. N FBI,FBMOD,FBMODX,FBPOS
|
|
. S FBPOS=$L($E($P($$CPT^ICPTCOD($P(FBCPT,"-"),"",1),U,3),1,39))+2
|
|
. F FBI=1:1 S FBMOD=$P($P(FBCPT,"-",2),",",FBI) Q:FBMOD="" D Q:FBAAOUT
|
|
. . I $Y+5>IOSL D HANG^FBAAUTL1:$E(IOST,1,2)="C-" Q:FBAAOUT W @IOF S FBPAGE=FBPAGE+1 D HEAD W " continued"
|
|
. . W ?FBPOS,"-"
|
|
. . S FBMODX=$$MOD^ICPTMOD(FBMOD,"E")
|
|
. . ; if modifier data not obtained then try another API to resolve it
|
|
. . ; since there can be duplicate modifiers with same external value
|
|
. . I $P(FBMODX,U)'>0 D
|
|
. . . N FBY
|
|
. . . S FBY=$$MODP^ICPTMOD($P(FBCPT,"-"),FBMOD,"E")
|
|
. . . I $P(FBY,U)>0 S FBMODX=$$MOD^ICPTMOD($P(FBY,U),"I")
|
|
. . W $E($S($P(FBMODX,U)>0:$P(FBMODX,U,3),1:FBMOD),1,36),!
|
|
E W !
|
|
W FBDASH
|
|
Q
|
|
;
|
|
HEAD W !!,?19,"**** REPORT OF FEE SCHEDULE ****",!!,?26,"For Fiscal Year ",FBFY,?70,"Page ",$G(FBPAGE),!!,$$REPEAT^XLFSTR("=",80)
|
|
W !!,"CPT-MOD",?10,"Total #",?25,"75 %ile",?40,"Date Compiled",?65,"Date Range ",!,?2,"Description",!,$$REPEAT^XLFSTR("=",80),!
|
|
Q
|
|
;
|
|
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
|
|
D CLOSE^FBAAUTL
|
|
Q
|
|
;
|
|
HELP W *7,!!,"There is no data on file for fiscal year ",FBFY,! G ASKDT
|