| 1 | PRCFFU1 ;WISC/SJG-BUILD FMS SEGMENTS ;11/26/93 16:10
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | NEW(RECNO,TRCODE,TYCODE) ;
|
|---|
| 6 | N NODE0,NODE1,TMPLINE,PRCBUD,PRCCC,PRCSTR,INT
|
|---|
| 7 | S NODE0=$G(^PRC(442,RECNO,0))
|
|---|
| 8 | S NODE1=$G(^PRC(442,RECNO,1))
|
|---|
| 9 | S INT=GECSFMS("DA")
|
|---|
| 10 | S PRCCC=+$P(PO(0),U,5)
|
|---|
| 11 | S PRCSTR=$$ACC^PRC0C(PRC("SITE"),+$P(PO(0),U,3)_"^"_PRC("FY")_"^"_PRCFA("BBFY"))
|
|---|
| 12 | DOC ; Build 'DOC' header segments
|
|---|
| 13 | S TMPLINE=0
|
|---|
| 14 | I TRCODE'="AR" D
|
|---|
| 15 | . D MO2^PRCFFU2(NODE1,TYCODE)
|
|---|
| 16 | . D MO3^PRCFFU21
|
|---|
| 17 | . D MO4^PRCFFU22
|
|---|
| 18 | I TRCODE="AR" D
|
|---|
| 19 | . D RC2^PRCFFU2A(NODE1,TYCODE)
|
|---|
| 20 | . D RC3^PRCFFU2A
|
|---|
| 21 | S PRCBUD=$$BUD^PRCFFU3(PRCSTR)
|
|---|
| 22 | I PRCFA("MP")=21,TYCODE="M",TRCODE'="MO" S NUMB=1 D LIN Q ; 1358 modification
|
|---|
| 23 | 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
|
|---|
| 24 | QUIT
|
|---|
| 25 | ;
|
|---|
| 26 | LIN ; Build 'LIN' line segments
|
|---|
| 27 | I TRCODE'="AR" D MOA^PRCFFU3
|
|---|
| 28 | I TRCODE="AR" D RCA^PRCFFU3A
|
|---|
| 29 | Q
|
|---|
