PRCFFU1.m

PRCFFU1 ;WISC/SJG-BUILD FMS SEGMENTS ;11/26/93  16:10

V ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

NEW(RECNO,TRCODE,TYCODE) ;

 N NODE0,NODE1,TMPLINE,PRCBUD,PRCCC,PRCSTR,INT

 S NODE0=$G(^PRC(442,RECNO,0))

 S NODE1=$G(^PRC(442,RECNO,1))

 S INT=GECSFMS("DA")

 S PRCCC=+$P(PO(0),U,5)

 S PRCSTR=$$ACC^PRC0C(PRC("SITE"),+$P(PO(0),U,3)_"^"_PRC("FY")_"^"_PRCFA("BBFY"))

DOC ; Build 'DOC' header segments

 S TMPLINE=0

 I TRCODE'="AR" D

 . D MO2^PRCFFU2(NODE1,TYCODE)

 . D MO3^PRCFFU21

 . D MO4^PRCFFU22

 I TRCODE="AR" D

 . D RC2^PRCFFU2A(NODE1,TYCODE)

 . D RC3^PRCFFU2A

 S PRCBUD=$$BUD^PRCFFU3(PRCSTR)

 I PRCFA("MP")=21,TYCODE="M",TRCODE'="MO" S NUMB=1 D LIN Q  ; 1358 modification

 N FMSLIN,FMSNOD S FMSLIN=0 F  S FMSLIN=$O(^PRC(442,RECNO,22,FMSLIN)) Q:FMSLIN=""!(FMSLIN'>0)  S FMSNOD=^PRC(442,RECNO,22,FMSLIN,0) D LIN

 QUIT

 ;

LIN ; Build 'LIN' line segments

 I TRCODE'="AR" D MOA^PRCFFU3

 I TRCODE="AR" D RCA^PRCFFU3A

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCFFU1   998     printed  Feb 18, 2025@23:29:56                                                                                                                                                                                                      Page 2

PRCFFU1   ;WISC/SJG-BUILD FMS SEGMENTS ;11/26/93  16:10

V         ;;5.1;IFCAP;;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +2       ;

NEW(RECNO,TRCODE,TYCODE) ;

 +1        NEW NODE0,NODE1,TMPLINE,PRCBUD,PRCCC,PRCSTR,INT

 +2        SET NODE0=$GET(^PRC(442,RECNO,0))

 +3        SET NODE1=$GET(^PRC(442,RECNO,1))

 +4        SET INT=GECSFMS("DA")

 +5        SET PRCCC=+$PIECE(PO(0),U,5)

 +6        SET PRCSTR=$$ACC^PRC0C(PRC("SITE"),+$PIECE(PO(0),U,3)_"^"_PRC("FY")_"^"_PRCFA("BBFY"))

DOC       ; Build 'DOC' header segments

 +1        SET TMPLINE=0

 +2        IF TRCODE'="AR"

               Begin DoDot:1

 +3                DO MO2^PRCFFU2(NODE1,TYCODE)

 +4                DO MO3^PRCFFU21

 +5                DO MO4^PRCFFU22

               End DoDot:1

 +6        IF TRCODE="AR"

               Begin DoDot:1

 +7                DO RC2^PRCFFU2A(NODE1,TYCODE)

 +8                DO RC3^PRCFFU2A

               End DoDot:1

 +9        SET PRCBUD=$$BUD^PRCFFU3(PRCSTR)

 +10      ; 1358 modification

           IF PRCFA("MP")=21

               IF TYCODE="M"

                   IF TRCODE'="MO"

                       SET NUMB=1

                       DO LIN

                       QUIT 

 +11       NEW FMSLIN,FMSNOD

           SET FMSLIN=0

           FOR 

               SET FMSLIN=$ORDER(^PRC(442,RECNO,22,FMSLIN))

               if FMSLIN=""!(FMSLIN'>0)

                   QUIT 

               SET FMSNOD=^PRC(442,RECNO,22,FMSLIN,0)

               DO LIN

 +12       QUIT 

 +13      ;

LIN       ; Build 'LIN' line segments

 +1        IF TRCODE'="AR"

               DO MOA^PRCFFU3

 +2        IF TRCODE="AR"

               DO RCA^PRCFFU3A

 +3        QUIT