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 ---[H[J[2J[HPRCFFU1 998 printed Nov 22, 2024@17:13:39 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
