Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCCPCFN

RCCPCFN.m

Go to the documentation of this file. 
  1. RCCPCFN ;WASH-ISC@ALTOONA,PA/NYB-Function calls for CCPC ;12/31/96  9:27 AM
  1. V ;;4.5;Accounts Receivable;**34,104,140,369**;Mar 20, 1995;Build 15
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;PRCA*4.5*369 Ensured name handler for statements would handle
  1.  ;
  1. FP() ;Returns facility phone number
  1.  N GRP,TYP
  1.  S TYP=$O(^RC(342.2,"B","AGENT CASHIER",0))
  1.  S GRP=$O(^RC(342.1,"AC",TYP,0))
  1.  Q $P($G(^RC(342.1,GRP,1)),"^",7)
  1. DAT(DAT) ;Changes date from FM to DDMMYYYY format for CCPC
  1.  N YR
  1.  I '$G(DAT) G QDAT
  1.  S YR=$E(($E(DAT,1,3)+1700),1,2)
  1.  Q $E(DAT,4,5)_$E(DAT,6,7)_$G(YR)_$E(DAT,2,3)
  1. QDAT Q ""
  1. NM(I340) ;Returns first, middle, and last name in 3 different variables   ;PRCA*4.5*369
  1. NM1 N FN,LN,MN,NM,XN,RCMN1,RCMN2 S XN=""
  1.  I '$D(I340) G QNM
  1.  S NM=$P($G(^RCPS(349.2,I340,0)),"^",3)
  1.  S LN=$P($G(NM),","),FN=$P($P($G(NM),",",2)," "),RCMN1=$P($P($G(NM),",",2)," ",2)
  1.  I ($E(RCMN1,1,2)="SR")!($E(RCMN1,1,2)="JR")!(RCMN1?2.3"I")!(RCMN1?0.1"I"1"V"1.3"I")!(RCMN1="IV") S XN=RCMN1,RCMN1=""
  1.  S RCMN2=$P($P($G(NM),",",2)," ",3)
  1.  I RCMN2]"",$G(XN)="" I ($E(RCMN2,1,2)="SR")!($E(RCMN2,1,2)="JR")!(RCMN2?2.3"I")!(RCMN2?0.1"I"1"V"1.3"I")!(RCMN2="IV") S XN=RCMN2,RCMN2=""
  1.  Q LN_" "_$G(XN)_"^"_FN_"^"_RCMN1_" "_RCMN2
  1. QNM Q ""
  1. STDY() ;Returns Site's Statement Day
  1.  N STDY
  1.  S STDY=$P($G(^RC(342,1,0)),"^",11)
  1.  I $L(STDY)=1 S STDY="0"_STDY
  1.  Q STDY
  1. STDT(SDT) ;Returns Site's Statement Date in MMDDYYYY format for CCPC
  1.  N MTH,STDY,YR
  1.  I SDT="" S SDT=DT
  1.  S STDY=$$STDY()
  1.  I '$G(STDY) S STDY=$E(SDT,6,7)
  1.  S YR=$E(($E(SDT,1,3)+1700),1,2)
  1.  I +$E(SDT,6,7)'>STDY S MTH=$E(SDT,4,5),YR=$G(YR)_$E(SDT,2,3)
  1.  I +$E(SDT,6,7)>STDY S MTH=$$FPS^RCAMFN01(SDT,1),YR=YR_$E(MTH,2,3),MTH=$E(MTH,4,5)
  1.  I +$E(SDT,6,7)'>STDY S MTH=$E(SDT,4,5)
  1.  Q MTH_STDY_$G(YR)
  1.  ;
  1. STD() ;Returns the Statement Date in Fileman format
  1.  N X
  1.  I (+$E(DT,6,7)>+$$STDY^RCCPCFN) S X=$$FPS^RCAMFN01($E(DT,1,5)_$$STDY^RCCPCFN,1)
  1.  E  S X=$E(DT,1,5)_$$STDY
  1.  Q X
  1. STM() ;Returns the Processing Date in DD MM YYYY format for CCPC
  1.  N X1,X2,YR
  1.  ;S X1=$$STD(),X2=-5 D C^%DTC
  1.  S X=$O(^RCPS(349.2,0)),X=$P($G(^RCPS(349.2,+X,0)),"^",10)
  1.  S X=$$ASOF(X)
  1.  S YR=$E(($E(X,1,3)+1700),1,2)
  1.  Q $E(X,4,5)_$E(X,6,7)_$G(YR)_$E(X,2,3)
  1.  ;
  1. KEY(PT) ;Returns CCPC KEY for patient from 340 IFN input
  1.  N X
  1.  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:"")
  1.  S X=$$UP^XLFSTR(X)
  1.  Q X
  1.  ;
  1. HEX(AMT) ;sets up amount formatted as 999999999V99S w/no leading blanks and trailing sign
  1.  I $G(AMT)'?.1"-".N.1".".N S AMT="" G Q
  1.  S AMT=$TR($J(AMT,9,2)," ","")
  1.  I $E(AMT)="-" S AMT=$E(AMT,2,99)_$E(AMT,1)
  1.  E  S AMT=AMT_"+"
  1.  S AMT=$P(AMT,".")_$P(AMT,".",2)
  1. Q Q AMT
  1.  ;
  1.  ;
  1. FPS(PT) ;Returns last statement date and activity as of
  1.  N Y
  1.  I '$G(PT) S Y="" G FPSQ
  1.  S Y=$O(^RC(341,"AD",+PT,2,0)),Y=$O(^RC(341,"AD",+PT,2,+Y,0))
  1.  I Y S Y=$G(^RC(341,+Y,6))_"^"_$P($G(^RC(341,+Y,0)),"^",7)
  1. FPSQ Q Y
  1.  ;
  1.  ;
  1. ASOF(DTE) ;Returns the as of date based upon time
  1.  N X
  1.  I '$G(DTE) G ASOFQ
  1.  S X=$P(DTE,".",2) I 'X S X=DTE G ASOFQ
  1.  I $E(X,1,2)'<18 S X=$P(DTE,".") G ASOFQ
  1.  I $E(X,1,2)<18 S X1=DTE,X2=-1 D C^%DTC S X=$P(X,".") G ASOFQ
  1. ASOFQ Q X