| 1 | FBCHPSA1 ;AISC/DMK-PSA OUTPUT CONTINUED ; 18JUN90
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | RX ;
|
|---|
| 5 | D HED^FBCHPSA K ^TMP("FBPSA",$J)
|
|---|
| 6 | I FBPSA>0 F FBI=FBBEG-.1:0 S FBI=$O(^FBAA(162.1,"AI",FBPSA,FBI)) Q:FBI'>0!(FBI>FBEND)!(FBAAOUT) D MORE
|
|---|
| 7 | I FBPSA=0 F FBPSA=0:0 S FBPSA=$O(^FBAA(162.1,"AI",FBPSA)) Q:FBPSA'>0!(FBAAOUT) F FBI=FBBEG-.1:0 S FBI=$O(^FBAA(162.1,"AI",FBPSA,FBI)) Q:FBI'>0!(FBI>FBEND)!(FBAAOUT) D MORE
|
|---|
| 8 | Q:FBAAOUT
|
|---|
| 9 | 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),"^")
|
|---|
| 10 | I '$D(^TMP("FBPSA",$J)) D NONE
|
|---|
| 11 | D HANG^FBCHPSA
|
|---|
| 12 | Q
|
|---|
| 13 | MORE F FBK=0:0 S FBK=$O(^FBAA(162.1,"AI",FBPSA,FBI,FBK)) Q:FBK'>0!(FBAAOUT) F FBL=0:0 S FBL=$O(^FBAA(162.1,"AI",FBPSA,FBI,FBK,FBL)) Q:FBL'>0!(FBAAOUT) I $D(^FBAA(162.1,FBK,"RX",FBL,0)) S FBI(0)=^(0),FBK(0)=^(2) D WRT
|
|---|
| 14 | Q
|
|---|
| 15 | WRT S DFN=$P(FBI(0),"^",5) D 4^VADPT S FBNAME=VADM(1),FBCOUNTY=$P(VAPA(7),"^",2),FBINV=FBK,FBAMTPD=$P(FBI(0),"^",16),FBPDDT=$P(FBI(0),"^",19),FBPDDT=$$DATX^FBAAUTL(FBPDDT),FBPPSA=$P(FBK(0),"^",5)
|
|---|
| 16 | S FBOBL=$S($P(FBI(0),"^",18)="":"Unknown",1:$P(FBI(0),"^",18))
|
|---|
| 17 | S FBSTA=$S($D(^DIC(4,FBPPSA,0)):$P(^(0),"^"),1:"Unknown")
|
|---|
| 18 | I $Y+4>IOSL D HANG^FBCHPSA Q:FBAAOUT D HED^FBCHPSA
|
|---|
| 19 | W !,$E(FBNAME,1,30)," -",VA("BID"),?42,FBOBL,?57,FBCOUNTY,!,?4,FBINV,?21,FBAMTPD,?39,FBPDDT,?60,FBSTA,!,Q,!
|
|---|
| 20 | S:'$D(^TMP("FBPSA",$J,FBPSA)) ^TMP("FBPSA",$J,FBPSA)=0
|
|---|
| 21 | S ^TMP("FBPSA",$J,FBPSA)=^TMP("FBPSA",$J,FBPSA)+FBAMTPD
|
|---|
| 22 | S:'$D(^TMP("FBTOT",$J,FBPSA)) ^TMP("FBTOT",$J,FBPSA)=0
|
|---|
| 23 | S ^TMP("FBTOT",$J,FBPSA)=^TMP("FBTOT",$J,FBPSA)+FBAMTPD
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | PROG ;one/many/all fee programs
|
|---|
| 27 | ; returns FBPROG(ien)=external value
|
|---|
| 28 | ;
|
|---|
| 29 | N DIC,VAUTSTR,VAUTNI,VAUTVB
|
|---|
| 30 | S DIC="^FBAA(161.8,",DIC("S")="I $P(^(0),U,3)"
|
|---|
| 31 | S VAUTSTR="FEE PROGRAM",VAUTNI=2,VAUTVB="FBPROG"
|
|---|
| 32 | D FIRST^VAUTOMA
|
|---|
| 33 | I 'FBPROG&('$O(FBPROG(0))) Q
|
|---|
| 34 | I FBPROG D
|
|---|
| 35 | . N X S X=0
|
|---|
| 36 | . F S X=$O(^FBAA(161.8,X)) Q:'X S X(0)=$G(^(X,0)) I $P(X(0),U,3) S FBPROG(X)=$P(X(0),U)
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | NONE ;write no payments found for this program and quit
|
|---|
| 40 | W !!,"No payments found for this Fee Program.",!
|
|---|
| 41 | Q
|
|---|
