| 1 | RCAMFN01 ;WASH-ISC@ALTOONA,PA/RGY-MISCELLANEOUS AR FUNCTIONS ;4/30/96 8:39 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**39,86**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | FPS(DATE,STM) ;
|
|---|
| 5 | ;Get a future or past statement date
|
|---|
| 6 | ;P1(STM)=statement date, P2(STM)=months to add or subtract
|
|---|
| 7 | NEW X,Y,END,YR,MT
|
|---|
| 8 | S Y=-1
|
|---|
| 9 | I $G(DATE)'?7N G Q1
|
|---|
| 10 | I $G(STM)'?.1"-"1N.N G Q1
|
|---|
| 11 | S YR=$E(DATE,1,3),MT=$E(DATE,4,5),Y=$S(STM<0:-STM,1:STM)
|
|---|
| 12 | F X=1:1:Y S MT=MT+$S(STM<0:-1,1:1) S:MT>12 YR=YR+1,MT=1 S:MT<1 YR=YR-1,MT=12
|
|---|
| 13 | S Y=YR_$S(MT<10:0_MT,1:MT)_$E(DATE,6,7)
|
|---|
| 14 | Q1 Q Y
|
|---|
| 15 | PST(Y) ;Input: debtor variable pointer value (EX: 1;DPT(, 34;DIC(36, etc)
|
|---|
| 16 | ;Return: Statement day or -1
|
|---|
| 17 | I '$D(Y) S Y=-1
|
|---|
| 18 | S:Y?1N.N Y=$P($G(^RCD(340,Y,0)),"^")
|
|---|
| 19 | S Y=$P($G(^RCD(340,+$O(^RCD(340,"B",Y,0)),0)),"^",3) S:'Y Y=-1
|
|---|
| 20 | Q Y
|
|---|
| 21 | REC(DEB) ;Return receivable code for debtor
|
|---|
| 22 | NEW X
|
|---|
| 23 | S X=""
|
|---|
| 24 | I $G(DEB)="" G Q4
|
|---|
| 25 | S:DEB'?1N.N DEB=$O(^RCD(340,"B",DEB,0))
|
|---|
| 26 | S X=$G(^RCD(340,DEB,0)) G:$P(X,"^")="" Q4
|
|---|
| 27 | I $P(X,"^")[";DPT(" S X=2 G Q4
|
|---|
| 28 | I $P(X,"^")[";VA(200," S X=2 G Q4
|
|---|
| 29 | I $P(X,"^")[";DIC(36" S X=$S($P(X,"^",5)=3:3,$P(X,"^",5)=1:1,1:2) G Q4
|
|---|
| 30 | I $P(X,"^")[";DIC(4," S X=$S($P(X,"^",5)=3:3,$P(X,"^",5)=2:2,1:1) G Q4
|
|---|
| 31 | I $P(X,"^")[";PRC(" S X=$S($P(X,"^",5)=3:3,$P(X,"^",5)=1:1,1:2) G Q4
|
|---|
| 32 | Q4 Q X
|
|---|
