source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCAMFN01.m@ 1261

Last change on this file since 1261 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1RCAMFN01 ;WASH-ISC@ALTOONA,PA/RGY-MISCELLANEOUS AR FUNCTIONS ;4/30/96 8:39 AM
2V ;;4.5;Accounts Receivable;**39,86**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4FPS(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)
14Q1 Q Y
15PST(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
21REC(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
32Q4 Q X
Note: See TracBrowser for help on using the repository browser.