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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCUFCA 936 printed Dec 13, 2024@02:19:40 Page 2
PRCUFCA ;WISC/SJG-BUILD FMS SEGMENTS FOR CONVERSION ONLY ;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 ;
+3 ; Routine is modification of PRCFFU1 for conversion processing
NEW(RECNO,TRCODE,TYCODE) ;
+1 NEW NODE0,NODE1,TMPLINE,PRCBUD,INT
+2 SET NODE0=$GET(^PRC(442,RECNO,0))
+3 SET NODE1=$GET(^PRC(442,RECNO,1))
+4 SET INT=GECSFMS("DA")
DOC ; Build 'DOC' header segments
+1 SET TMPLINE=0
+2 DO MO2^PRCUFCF(NODE1,TYCODE)
+3 DO MO3^PRCUFCB
+4 DO MO4^PRCFFU22
+5 SET PRCBUD=$$BUD^PRCFFU3(PRCSTR)
+6 IF PRCFA("MP")=21
IF (TRCODE="SO")&(TYCODE="M")
SET NUMB=1
DO MOA^PRCUFCC
QUIT
+7 NEW BOC,FMSBOC,LINE,FMSNOD
+8 SET BOC=""
FOR
SET BOC=$ORDER(PRCFA("BOC",BOC))
if BOC=""!(BOC'>0)
QUIT
Begin DoDot:1
+9 SET LINE=""
FOR
SET LINE=$ORDER(PRCFA("BOC",BOC,LINE))
if LINE=""!(LINE'>0)
QUIT
Begin DoDot:2
+10 SET FMSBOC=$PIECE(PRCFA("BOC",BOC,LINE),U)
+11 SET FMSNOD=PRCFCHG("BOC",FMSBOC,LINE)
+12 DO LIN
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 QUIT
+16 ;
LIN ; Build 'LIN' line segments
+1 DO MOA^PRCUFCC
+2 QUIT
