| 1 | RCFN01 ;WASH-ISC@ALTOONA,PA/RGY-MISCELLANEOUS AR FUNCTIONS ;4/30/96 9:06 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**39,65,104,184**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | SSN(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)
|
|---|
| 12 | Q1 Q Y
|
|---|
| 13 | SADD(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)
|
|---|
| 21 | Q2 Q X
|
|---|
| 22 | NAM(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)")),"^")
|
|---|
| 27 | Q3 Q Y
|
|---|
| 28 | LST(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))
|
|---|
| 35 | Q4 Q Y
|
|---|
| 36 | DET(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)
|
|---|
| 41 | Q5 Q Y
|
|---|
| 42 | SLH(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)
|
|---|
| 46 | Q6 Q $E(DATE,4,5)_DEL_$E(DATE,6,7)_DEL_$G(YR)_$E(DATE,2,3)
|
|---|
| 47 | ARPS(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
|
|---|
| 56 | FY(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 | ;
|
|---|
| 66 | INTEG(SITE) ;integrated site
|
|---|
| 67 | N X
|
|---|
| 68 | S X=+$P($G(^RC(342,1,6)),U)
|
|---|
| 69 | Q X
|
|---|
| 70 | ;
|
|---|
