31 lines
906 B
Mathematica
31 lines
906 B
Mathematica
PRCUFCA ;WISC/SJG-BUILD FMS SEGMENTS FOR CONVERSION ONLY ;11/26/93 16:10
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
; Routine is modification of PRCFFU1 for conversion processing
|
|
NEW(RECNO,TRCODE,TYCODE) ;
|
|
N NODE0,NODE1,TMPLINE,PRCBUD,INT
|
|
S NODE0=$G(^PRC(442,RECNO,0))
|
|
S NODE1=$G(^PRC(442,RECNO,1))
|
|
S INT=GECSFMS("DA")
|
|
DOC ; Build 'DOC' header segments
|
|
S TMPLINE=0
|
|
D MO2^PRCUFCF(NODE1,TYCODE)
|
|
D MO3^PRCUFCB
|
|
D MO4^PRCFFU22
|
|
S PRCBUD=$$BUD^PRCFFU3(PRCSTR)
|
|
I PRCFA("MP")=21 I (TRCODE="SO")&(TYCODE="M") S NUMB=1 D MOA^PRCUFCC Q
|
|
N BOC,FMSBOC,LINE,FMSNOD
|
|
S BOC="" F S BOC=$O(PRCFA("BOC",BOC)) Q:BOC=""!(BOC'>0) D
|
|
.S LINE="" F S LINE=$O(PRCFA("BOC",BOC,LINE)) Q:LINE=""!(LINE'>0) D
|
|
..S FMSBOC=$P(PRCFA("BOC",BOC,LINE),U)
|
|
..S FMSNOD=PRCFCHG("BOC",FMSBOC,LINE)
|
|
..D LIN
|
|
..Q
|
|
.Q
|
|
QUIT
|
|
;
|
|
LIN ; Build 'LIN' line segments
|
|
D MOA^PRCUFCC
|
|
Q
|