- 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 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