PRCHPRC1.m

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 ---PRCHPRC1   704     printed  Apr 09, 2024@21:08:36                                                                                                                                                                                                     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