PRCFD8 ;WISC/LEM-BUILD FMS PV SEGMENTS ;8/29/94 15:35
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
NEW(CI,ACTION) ;
HDR ; Build header segments
D PV2^PRCFD8H(CI,ACTION)
D PV3^PRCFD8H
D PV4^PRCFD8H
D PV5^PRCFD8H
S DIC=421.5,(DA,CIDA)=CI,DR=31,DR(421.531)=".01;1;2;3;4"
S DIQ="PRCTMP(",DIQ(0)="IE"
F DA(421.531)=1:1:3 D EN^DIQ1
K DA(421.531),DR S DR=41,DR(421.541)=".01;1;2;3;4"
S LINE=0 F S LINE=$O(^PRCF(421.5,CIDA,5,LINE)) Q:'+LINE D LIN(LINE)
K LINE,CIDA,DA,DIC,DIQ,DR
Q
LIN(LINE) ; Build 'LIN' segments
D LIN^PRCFD8L
D PVA^PRCFD8L
D PVB^PRCFD8L
D PVC^PRCFD8L
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFD8 660 printed Dec 13, 2024@02:02:41 Page 2
PRCFD8 ;WISC/LEM-BUILD FMS PV SEGMENTS ;8/29/94 15:35
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
NEW(CI,ACTION) ;
HDR ; Build header segments
+1 DO PV2^PRCFD8H(CI,ACTION)
+2 DO PV3^PRCFD8H
+3 DO PV4^PRCFD8H
+4 DO PV5^PRCFD8H
+5 SET DIC=421.5
SET (DA,CIDA)=CI
SET DR=31
SET DR(421.531)=".01;1;2;3;4"
+6 SET DIQ="PRCTMP("
SET DIQ(0)="IE"
+7 FOR DA(421.531)=1:1:3
DO EN^DIQ1
+8 KILL DA(421.531),DR
SET DR=41
SET DR(421.541)=".01;1;2;3;4"
+9 SET LINE=0
FOR
SET LINE=$ORDER(^PRCF(421.5,CIDA,5,LINE))
if '+LINE
QUIT
DO LIN(LINE)
+10 KILL LINE,CIDA,DA,DIC,DIQ,DR
+11 QUIT
LIN(LINE) ; Build 'LIN' segments
+1 DO LIN^PRCFD8L
+2 DO PVA^PRCFD8L
+3 DO PVB^PRCFD8L
+4 DO PVC^PRCFD8L
+5 QUIT
