source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFU1.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 969 bytes
Line 
1PRCFFU1 ;WISC/SJG-BUILD FMS SEGMENTS ;11/26/93 16:10
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5NEW(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"))
12DOC ; 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 ;
26LIN ; Build 'LIN' line segments
27 I TRCODE'="AR" D MOA^PRCFFU3
28 I TRCODE="AR" D RCA^PRCFFU3A
29 Q
Note: See TracBrowser for help on using the repository browser.