PRCUFCA.m

PRCUFCA ;WISC/SJG-BUILD FMS SEGMENTS FOR CONVERSION ONLY ;11/26/93  16:10

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

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

 ;

 ; Routine is modification of PRCFFU1 for conversion processing

NEW(RECNO,TRCODE,TYCODE) ;

 N NODE0,NODE1,TMPLINE,PRCBUD,INT

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

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

 S INT=GECSFMS("DA")

DOC ; Build 'DOC' header segments

 S TMPLINE=0

 D MO2^PRCUFCF(NODE1,TYCODE)

 D MO3^PRCUFCB

 D MO4^PRCFFU22

 S PRCBUD=$$BUD^PRCFFU3(PRCSTR)

 I PRCFA("MP")=21 I (TRCODE="SO")&(TYCODE="M") S NUMB=1 D MOA^PRCUFCC Q

 N BOC,FMSBOC,LINE,FMSNOD

 S BOC="" F  S BOC=$O(PRCFA("BOC",BOC)) Q:BOC=""!(BOC'>0)  D

 .S LINE="" F  S LINE=$O(PRCFA("BOC",BOC,LINE)) Q:LINE=""!(LINE'>0)  D

 ..S FMSBOC=$P(PRCFA("BOC",BOC,LINE),U)

 ..S FMSNOD=PRCFCHG("BOC",FMSBOC,LINE)

 ..D LIN

 ..Q

 .Q

 QUIT

 ;

LIN ; Build 'LIN' line segments

 D MOA^PRCUFCC

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCUFCA   936     printed  Mar 13, 2025@21:24:27                                                                                                                                                                                                      Page 2

PRCUFCA   ;WISC/SJG-BUILD FMS SEGMENTS FOR CONVERSION ONLY ;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       ;

 +3       ; Routine is modification of PRCFFU1 for conversion processing

NEW(RECNO,TRCODE,TYCODE) ;

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

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

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

 +4        SET INT=GECSFMS("DA")

DOC       ; Build 'DOC' header segments

 +1        SET TMPLINE=0

 +2        DO MO2^PRCUFCF(NODE1,TYCODE)

 +3        DO MO3^PRCUFCB

 +4        DO MO4^PRCFFU22

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

 +6        IF PRCFA("MP")=21

               IF (TRCODE="SO")&(TYCODE="M")

                   SET NUMB=1

                   DO MOA^PRCUFCC

                   QUIT 

 +7        NEW BOC,FMSBOC,LINE,FMSNOD

 +8        SET BOC=""

           FOR 

               SET BOC=$ORDER(PRCFA("BOC",BOC))

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

                   QUIT 

               Begin DoDot:1

 +9                SET LINE=""

                   FOR 

                       SET LINE=$ORDER(PRCFA("BOC",BOC,LINE))

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

                           QUIT 

                       Begin DoDot:2

 +10                       SET FMSBOC=$PIECE(PRCFA("BOC",BOC,LINE),U)

 +11                       SET FMSNOD=PRCFCHG("BOC",FMSBOC,LINE)

 +12                       DO LIN

 +13                       QUIT 

                       End DoDot:2

 +14               QUIT 

               End DoDot:1

 +15       QUIT 

 +16      ;

LIN       ; Build 'LIN' line segments

 +1        DO MOA^PRCUFCC

 +2        QUIT