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