| 1 | FBCHPSA0 ;AISC/DMK-PSA OUTPUT CONTINUED ;13JUN90
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D HED^FBCHPSA K ^TMP("FBPSA",$J)
|
|---|
| 5 | EN I FBPSA>0 F FBI=FBBEG-.1:0 S FBI=$O(^FBAAC("AQ",FBPSA,FBI)) Q:FBI'>0!(FBI>FBEND)!(FBAAOUT) F FBJ=0:0 S FBJ=$O(^FBAAC("AQ",FBPSA,FBI,FBJ)) Q:FBJ'>0!(FBAAOUT) F FBK=0:0 S FBK=$O(^FBAAC("AQ",FBPSA,FBI,FBJ,FBK)) Q:FBK'>0!(FBAAOUT) D MORE
|
|---|
| 6 | I FBPSA=0 F FBPSA=0:0 S FBPSA=$O(^FBAAC("AQ",FBPSA)) Q:FBPSA'>0!(FBAAOUT) F FBI=FBBEG-.1:0 S FBI=$O(^FBAAC("AQ",FBPSA,FBI)) Q:FBI'>0!(FBI>FBEND)!(FBAAOUT) F FBJ=0:0 S FBJ=$O(^FBAAC("AQ",FBPSA,FBI,FBJ)) Q:FBJ'>0 D MORE1
|
|---|
| 7 | Q:FBAAOUT
|
|---|
| 8 | I $D(^TMP("FBPSA",$J)) D HED1^FBCHPSA F I=0:0 S I=$O(^TMP("FBPSA",$J,I)) Q:I'>0 S FBSTA=$S($D(^DIC(4,I,0)):$P(^(0),"^"),1:"Unknown") W !?2,FBSTA,?44,"$ ",$P(^TMP("FBPSA",$J,I),"^")
|
|---|
| 9 | I '$D(^TMP("FBPSA",$J)) D NONE^FBCHPSA1
|
|---|
| 10 | D HANG^FBCHPSA
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | PSATOT Q:'$O(^TMP("FBTOT",$J,0)) D HED2
|
|---|
| 14 | F I=0:0 S I=$O(^TMP("FBTOT",$J,I)) Q:I'>0 S FBSTA=$S($D(^DIC(4,I,0)):$P(^(0),"^"),1:"Unknown") W !?2,FBSTA,?44,"$ ",^TMP("FBTOT",$J,I)
|
|---|
| 15 | Q
|
|---|
| 16 | HED2 W @IOF,!?13,"TOTALS DOLLAR AMOUNT BY PSA FOR ALL SELECTED PROGRAMS",!?12,$E(Q,1,55),!!,"For Date Range: ",BEGDATE," to ",ENDDATE,!,QQ
|
|---|
| 17 | W !?5,"PSA",?40,"TOTAL AMOUNT",!,?4,"-----",?39,"--------------------"
|
|---|
| 18 | Q
|
|---|
| 19 | MORE F FBL=0:0 S FBL=$O(^FBAAC("AQ",FBPSA,FBI,FBJ,FBK,FBL)) Q:FBL'>0!(FBAAOUT) F FBM=0:0 S FBM=$O(^FBAAC("AQ",FBPSA,FBI,FBJ,FBK,FBL,FBM)) Q:FBM'>0 I $D(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,0)) S FBY(0)=^(0) D GET
|
|---|
| 20 | Q
|
|---|
| 21 | GET S DFN=FBJ,VAPA("P")="" D 4^VADPT S FBNAME=VADM(1),FBCOUNTY=$P(VAPA(7),"^",2),FBINV=$P(FBY(0),"^",16),FBAMTPD=$P(FBY(0),"^",3),FBPDDT=$P(FBY(0),"^",6),FBPDDT=$$DATX^FBAAUTL(FBPDDT),FBPPSA=$P(FBY(0),"^",12)
|
|---|
| 22 | S FBOBL=$S($P(FBY(0),"^",10)="":"Unknown",1:$P(FBY(0),"^",10))
|
|---|
| 23 | S FBSTA=$S($D(^DIC(4,FBPPSA,0)):$P(^(0),"^"),1:"Unknown")
|
|---|
| 24 | I $Y+4>IOSL D HANG^FBCHPSA Q:FBAAOUT D HED^FBCHPSA
|
|---|
| 25 | W !,$E(FBNAME,1,30)," -",VA("BID"),?42,FBOBL,?57,FBCOUNTY,!,?4,FBINV,?21,FBAMTPD,?39,FBPDDT,?60,FBSTA,!,Q,!
|
|---|
| 26 | S:'$D(^TMP("FBPSA",$J,FBPSA)) ^TMP("FBPSA",$J,FBPSA)=0
|
|---|
| 27 | S ^TMP("FBPSA",$J,FBPSA)=^TMP("FBPSA",$J,FBPSA)+FBAMTPD
|
|---|
| 28 | S:'$D(^TMP("FBTOT",$J,FBPSA)) ^TMP("FBTOT",$J,FBPSA)=0
|
|---|
| 29 | S ^TMP("FBTOT",$J,FBPSA)=^TMP("FBTOT",$J,FBPSA)+FBAMTPD
|
|---|
| 30 | Q
|
|---|
| 31 | MORE1 F FBK=0:0 S FBK=$O(^FBAAC("AQ",FBPSA,FBI,FBJ,FBK)) Q:FBK'>0!(FBAAOUT) F FBL=0:0 S FBL=$O(^FBAAC("AQ",FBPSA,FBI,FBJ,FBK,FBL)) Q:FBL'>0!(FBAAOUT) F FBM=0:0 S FBM=$O(^FBAAC("AQ",FBPSA,FBI,FBJ,FBK,FBL,FBM)) Q:FBM'>0 D MORE2
|
|---|
| 32 | Q
|
|---|
| 33 | MORE2 I $D(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,0)) S FBY(0)=^(0) D GET
|
|---|
| 34 | Q
|
|---|
