source: FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCCPCFN.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1RCCPCFN ;WASH-ISC@ALTOONA,PA/NYB-Function calls for CCPC ;12/31/96 9:27 AM
2V ;;4.5;Accounts Receivable;**34,104,140**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4FP() ;Returns facility phone number
5 N GRP,TYP
6 S TYP=$O(^RC(342.2,"B","AGENT CASHIER",0))
7 S GRP=$O(^RC(342.1,"AC",TYP,0))
8 Q $P($G(^RC(342.1,GRP,1)),"^",7)
9DAT(DAT) ;Changes date from FM to DDMMYYYY format for CCPC
10 N YR
11 I '$G(DAT) G QDAT
12 S YR=$E(($E(DAT,1,3)+1700),1,2)
13 Q $E(DAT,4,5)_$E(DAT,6,7)_$G(YR)_$E(DAT,2,3)
14QDAT Q ""
15NM(I340) ;Returns first, middle, and last name in 3 different variables
16 N FN,LN,MN,NM,XN
17 I '$D(I340) G QNM
18 S NM=$P($G(^RCPS(349.2,I340,0)),"^",3)
19 S LN=$P($G(NM),","),MN=$P($P($G(NM),",",2)," ",2)
20 I ($E(MN,1,2)="SR")!($E(MN,1,2)="JR")!(MN?2.3"I")!(MN?0.1"I"1"V"1.3"I") S XN=MN,MN=""
21 I $G(XN)="" S XN=$P($G(NM),",",3)
22 I $G(XN)="" S XN=$P($P($G(NM),",",2)," ",3)
23 S FN=$P($P($G(NM),",",2)," ")
24 Q LN_" "_$G(XN)_"^"_FN_"^"_MN
25QNM Q ""
26STDY() ;Returns Site's Statement Day
27 N STDY
28 S STDY=$P($G(^RC(342,1,0)),"^",11)
29 I $L(STDY)=1 S STDY="0"_STDY
30 Q STDY
31STDT(SDT) ;Returns Site's Statement Date in MMDDYYYY format for CCPC
32 N MTH,STDY,YR
33 I SDT="" S SDT=DT
34 S STDY=$$STDY()
35 I '$G(STDY) S STDY=$E(SDT,6,7)
36 S YR=$E(($E(SDT,1,3)+1700),1,2)
37 I +$E(SDT,6,7)'>STDY S MTH=$E(SDT,4,5),YR=$G(YR)_$E(SDT,2,3)
38 I +$E(SDT,6,7)>STDY S MTH=$$FPS^RCAMFN01(SDT,1),YR=YR_$E(MTH,2,3),MTH=$E(MTH,4,5)
39 I +$E(SDT,6,7)'>STDY S MTH=$E(SDT,4,5)
40 Q MTH_STDY_$G(YR)
41 ;
42STD() ;Returns the Statement Date in Fileman format
43 N X
44 I (+$E(DT,6,7)>+$$STDY^RCCPCFN) S X=$$FPS^RCAMFN01($E(DT,1,5)_$$STDY^RCCPCFN,1)
45 E S X=$E(DT,1,5)_$$STDY
46 Q X
47STM() ;Returns the Processing Date in DD MM YYYY format for CCPC
48 N X1,X2,YR
49 ;S X1=$$STD(),X2=-5 D C^%DTC
50 S X=$O(^RCPS(349.2,0)),X=$P($G(^RCPS(349.2,+X,0)),"^",10)
51 S X=$$ASOF(X)
52 S YR=$E(($E(X,1,3)+1700),1,2)
53 Q $E(X,4,5)_$E(X,6,7)_$G(YR)_$E(X,2,3)
54 ;
55KEY(PT) ;Returns CCPC KEY for patient from 340 IFN input
56 N X
57 S X=$S(($P($G(^RCPS(349.2,+PT,0)),"^",2)]"")&($P($G(^(0)),"^",3)]""):$TR($E($P(^(0),"^",2),1,9)_$E($P($P(^(0),"^",3),","),1,5)," ",""),1:"")
58 S X=$$UP^XLFSTR(X)
59 Q X
60 ;
61HEX(AMT) ;sets up amount formatted as 999999999V99S w/no leading blanks and trailing sign
62 I $G(AMT)'?.1"-".N.1".".N S AMT="" G Q
63 S AMT=$TR($J(AMT,9,2)," ","")
64 I $E(AMT)="-" S AMT=$E(AMT,2,99)_$E(AMT,1)
65 E S AMT=AMT_"+"
66 S AMT=$P(AMT,".")_$P(AMT,".",2)
67Q Q AMT
68 ;
69 ;
70FPS(PT) ;Returns last statement date and activity as of
71 N Y
72 I '$G(PT) S Y="" G FPSQ
73 S Y=$O(^RC(341,"AD",+PT,2,0)),Y=$O(^RC(341,"AD",+PT,2,+Y,0))
74 I Y S Y=$G(^RC(341,+Y,6))_"^"_$P($G(^RC(341,+Y,0)),"^",7)
75FPSQ Q Y
76 ;
77 ;
78ASOF(DTE) ;Returns the as of date based upon time
79 N X
80 I '$G(DTE) G ASOFQ
81 S X=$P(DTE,".",2) I 'X S X=DTE G ASOFQ
82 I $E(X,1,2)'<18 S X=$P(DTE,".") G ASOFQ
83 I $E(X,1,2)<18 S X1=DTE,X2=-1 D C^%DTC S X=$P(X,".") G ASOFQ
84ASOFQ Q X
Note: See TracBrowser for help on using the repository browser.