source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCUFCA.m@ 1800

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

initial load of WorldVistAEHR

File size: 906 bytes
RevLine 
[613]1PRCUFCA ;WISC/SJG-BUILD FMS SEGMENTS FOR CONVERSION ONLY ;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 ;
5 ; Routine is modification of PRCFFU1 for conversion processing
6NEW(RECNO,TRCODE,TYCODE) ;
7 N NODE0,NODE1,TMPLINE,PRCBUD,INT
8 S NODE0=$G(^PRC(442,RECNO,0))
9 S NODE1=$G(^PRC(442,RECNO,1))
10 S INT=GECSFMS("DA")
11DOC ; Build 'DOC' header segments
12 S TMPLINE=0
13 D MO2^PRCUFCF(NODE1,TYCODE)
14 D MO3^PRCUFCB
15 D MO4^PRCFFU22
16 S PRCBUD=$$BUD^PRCFFU3(PRCSTR)
17 I PRCFA("MP")=21 I (TRCODE="SO")&(TYCODE="M") S NUMB=1 D MOA^PRCUFCC Q
18 N BOC,FMSBOC,LINE,FMSNOD
19 S BOC="" F S BOC=$O(PRCFA("BOC",BOC)) Q:BOC=""!(BOC'>0) D
20 .S LINE="" F S LINE=$O(PRCFA("BOC",BOC,LINE)) Q:LINE=""!(LINE'>0) D
21 ..S FMSBOC=$P(PRCFA("BOC",BOC,LINE),U)
22 ..S FMSNOD=PRCFCHG("BOC",FMSBOC,LINE)
23 ..D LIN
24 ..Q
25 .Q
26 QUIT
27 ;
28LIN ; Build 'LIN' line segments
29 D MOA^PRCUFCC
30 Q
Note: See TracBrowser for help on using the repository browser.