source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCFN01.m@ 1710

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1RCFN01 ;WASH-ISC@ALTOONA,PA/RGY-MISCELLANEOUS AR FUNCTIONS ;4/30/96 9:06 AM
2V ;;4.5;Accounts Receivable;**39,65,104,184**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4SSN(DEBT) ;Get SSN for debtor
5 ;Input Debtor (340)
6 ;Output: SSN # or null
7 NEW Y
8 S Y=-1 G:'$G(DEBT) Q1
9 S:DEBT?1N.N DEBT=$P($G(^RCD(340,DEBT,0)),"^")
10 I DEBT[";DPT(" S Y=$P($G(^DPT(+DEBT,0)),"^",9)
11 I DEBT[";VA(200," S Y=$P($G(^VA(200,+DEBT,1)),"^",9)
12Q1 Q Y
13SADD(TYPE) ;Get AR Group address
14 ;Input Type of Address (342.1)
15 ;Output: Str1^Str2^Str3^City^State^Zip^Phone
16 NEW X
17 S X="" G:$G(TYPE)="" Q2 I ",1,2,3,4,5,8,"'[(","_TYPE_","),TYPE'?1N.N1";RC(342.1," G Q2
18 I TYPE?1N.N S TYPE=$O(^RC(342.1,"AC",TYPE,0)) G:TYPE="" Q2 S TYPE=TYPE_";RC(342.1,"
19 S X=$P($G(^RC(342.1,+TYPE,1)),"^",1,8)
20 S:$P(X,"^",5) $P(X,"^",5)=$P($G(^DIC(5,+$P(X,"^",5),0)),"^",2) S:$P(X,"^",6)?9N $P(X,"^",6)=$E($P(X,"^",6),1,5)_"-"_$E($P(X,"^",6),6,9)
21Q2 Q X
22NAM(DEBT) ;Get DEBTOR name
23 NEW Y
24 S Y="" G:'$G(DEBT) Q3
25 S:DEBT?1N.N DEBT=$P($G(^RCD(340,DEBT,0)),"^") G:DEBT="" Q3
26 S Y=$P($G(@("^"_$P(DEBT,";",2)_(+DEBT)_",0)")),"^")
27Q3 Q Y
28LST(DEBT,TYPE) ;Get last type of event for debtor
29 NEW Y
30 S Y=-1 G:'$G(DEBT)!'$G(TYPE) Q4
31 S:DEBT?1N.N1";"1A.A1"(" DEBT=$O(^RCD(340,"B",DEBT,0))
32 S TYPE=+$O(^RC(341.1,"AC",TYPE,0))
33 S Y=+$O(^RC(341,"AD",DEBT,TYPE,0)) I 'Y S Y=-1 G Q4
34 S Y=9999999.999999-Y_"^"_$O(^RC(341,"AD",DEBT,TYPE,Y,0))
35Q4 Q Y
36DET(DEBT) ;Return type of detail for RX info
37 NEW Y
38 S Y=$S($P($G(^RC(342,1,0)),"^",5):$P(^(0),"^",5),1:1) G:'$G(DEBT) Q5
39 S:DEBT?1N.N1";"1A.A1"(" DEBT=$O(^RCD(340,"B",DEBT,""))
40 I $P($G(^RCD(340,DEBT,0)),"^",2) S Y=$P(^(0),"^",2)
41Q5 Q Y
42SLH(DATE,DEL) ;Return date format of mm/dd/yyyy
43 NEW %DT,X,Y,YR
44 S X=$G(DATE),DEL=$S($G(DEL)="":"/",1:DEL),%DT="T" D ^%DT S DATE=Y S:Y<0 DATE="0000000"
45 S YR=$E(($E(DATE,1,3)+1700),1,2)
46Q6 Q $E(DATE,4,5)_DEL_$E(DATE,6,7)_DEL_$G(YR)_$E(DATE,2,3)
47ARPS(BN,DA) ;Determines the purge status of a bill
48 ;Input: Bill no. (BN) and file 442 record IEN (DA)
49 ;Output: Value of 1 (purge) or 0 (don't purge)
50 NEW X,Y
51 I $G(BN)=""!($G(DA)="") Q 0
52 I '$D(^PRCA(430,"B",BN)),'$D(^PRCA(430,"F",DA)) Q 1
53 I $D(^PRCA(430,"B",BN)) S X=+$O(^(BN,0)) I X>0,$D(^PRCA(430.3,"AC",115,+$P(^PRCA(430,X,0),U,8))) Q 1
54 I $D(^PRCA(430,"F",DA)) S Y=+$O(^(DA,0)) I Y>0,$D(^PRCA(430.3,"AC",115,+$P(^PRCA(430,Y,0),U,8))) Q 1
55 Q 0
56FY(DATE) ;Return FY for date, DT is default
57 NEW FY
58 S:$G(DATE)'?7N.E DATE=DT
59 S FY=$E(DATE,2,3) S:$E(DATE,4,5)>9 FY=FY+1 S:FY=100 FY="00"
60 I +$E(DATE,4,5)=9 D
61 .I $E(DATE,6,7)>$E($$LDATE^RCRJR(DATE),6,7) S FY=FY+1
62 .Q
63 S:$L(FY)<2 FY="0"_FY
64 Q FY
65 ;
66INTEG(SITE) ;integrated site
67 N X
68 S X=+$P($G(^RC(342,1,6)),U)
69 Q X
70 ;
Note: See TracBrowser for help on using the repository browser.