PRCHPRC1 ;WISC/DJM-FILE 442 CONVERSION ROUTINE, CONTINUED ;1/15/95 1:40 PM
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
BBFY(A,B,C) ;A=station #, B=fcp#, C=1 if display available year
;EF value ~1=0-node of file 420.14, ~2=fcp bbfy, ~3=length of fund, ~4=default year
N D,E,F,G,H,I,J
S D=$G(^PRC(420,+A,1,+B,5)) I D="" QUIT ""
S E=+$$DATE^PRC0C($P(D,"^",8),"I")
S F=$$FUND^PRC0C($P(D,"^",1),E) I F="" QUIT ""
S $P(F,"~",2)=E,G=$P(F,"^",5)-$P(F,"^",4)+1,$P(F,"~",3)=G
S J=+$$DATE^PRC0C($H,"H"),$P(F,"~",4)=J
I C D
. F I=J-G+1:1:J+G+1 Q:I-E#G=0
. S E=I,I="" F H=-3*G+E:G:3*G+E S I=I_H_" " S:H'>J $P(F,"~",4)=H
. QUIT
QUIT F
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHPRC1 704 printed Dec 13, 2024@02:09:29 Page 2
PRCHPRC1 ;WISC/DJM-FILE 442 CONVERSION ROUTINE, CONTINUED ;1/15/95 1:40 PM
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
BBFY(A,B,C) ;A=station #, B=fcp#, C=1 if display available year
+1 ;EF value ~1=0-node of file 420.14, ~2=fcp bbfy, ~3=length of fund, ~4=default year
+2 NEW D,E,F,G,H,I,J
+3 SET D=$GET(^PRC(420,+A,1,+B,5))
IF D=""
QUIT ""
+4 SET E=+$$DATE^PRC0C($PIECE(D,"^",8),"I")
+5 SET F=$$FUND^PRC0C($PIECE(D,"^",1),E)
IF F=""
QUIT ""
+6 SET $PIECE(F,"~",2)=E
SET G=$PIECE(F,"^",5)-$PIECE(F,"^",4)+1
SET $PIECE(F,"~",3)=G
+7 SET J=+$$DATE^PRC0C($HOROLOG,"H")
SET $PIECE(F,"~",4)=J
+8 IF C
Begin DoDot:1
+9 FOR I=J-G+1:1:J+G+1
if I-E#G=0
QUIT
+10 SET E=I
SET I=""
FOR H=-3*G+E:G:3*G+E
SET I=I_H_" "
if H'>J
SET $PIECE(F,"~",4)=H
+11 QUIT
End DoDot:1
+12 QUIT F
