PRCIREC ;WISC/SWS-PRCIREC continued ;9/7/06 14:22
V ;;5.1;IFCAP;**113,149**;Oct 20, 2000;Build 5
;Per VHA Directive 2004-038, this routine should not be modified.
;This routine serves as the input transform for the field Final Charge in File ^PRCH(440.6
;PRC*5.1*149 checks the 'PO' index in file 440.6 as the check for order number in 'C' x-ref was not valid order number, but charge returned order info
Q
START S MYIEN=$P($G(^PRCH(440.6,DA,1)),U) S:'MYIEN MYIEN=$G(PRCRI(442))
I '$G(MYIEN) Q
S VALUE2=MYIEN,VALUE3=0,BFLAG=0
F S VALUE3=$O(^PRCH(440.6,"PO",VALUE2,VALUE3)) Q:'VALUE3!(BFLAG=1) D
.I VALUE3'=DA D
..I $P($G(^PRCH(440.6,VALUE3,1)),U,4)="Y" D
...S BFLAG=1
...K MSG
...S MSG(1)="Sorry, there is already a final charge for this PC Order."
...S MSG(2)="You need to edit or remove the first final charge to continue."
...S MSG(2,"F")="!"
...S MSG(3)=""
...S MSG(3,"F")="!"
...D EN^DDIOL(.MSG)
...K MSG,X
...S BFLAG=1
K BFLAG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCIREC 983 printed Sep 23, 2025@19:47:36 Page 2
PRCIREC ;WISC/SWS-PRCIREC continued ;9/7/06 14:22
V ;;5.1;IFCAP;**113,149**;Oct 20, 2000;Build 5
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
+2 ;This routine serves as the input transform for the field Final Charge in File ^PRCH(440.6
+3 ;PRC*5.1*149 checks the 'PO' index in file 440.6 as the check for order number in 'C' x-ref was not valid order number, but charge returned order info
+4 QUIT
START SET MYIEN=$PIECE($GET(^PRCH(440.6,DA,1)),U)
if 'MYIEN
SET MYIEN=$GET(PRCRI(442))
+1 IF '$GET(MYIEN)
QUIT
+2 SET VALUE2=MYIEN
SET VALUE3=0
SET BFLAG=0
+3 FOR
SET VALUE3=$ORDER(^PRCH(440.6,"PO",VALUE2,VALUE3))
if 'VALUE3!(BFLAG=1)
QUIT
Begin DoDot:1
+4 IF VALUE3'=DA
Begin DoDot:2
+5 IF $PIECE($GET(^PRCH(440.6,VALUE3,1)),U,4)="Y"
Begin DoDot:3
+6 SET BFLAG=1
+7 KILL MSG
+8 SET MSG(1)="Sorry, there is already a final charge for this PC Order."
+9 SET MSG(2)="You need to edit or remove the first final charge to continue."
+10 SET MSG(2,"F")="!"
+11 SET MSG(3)=""
+12 SET MSG(3,"F")="!"
+13 DO EN^DDIOL(.MSG)
+14 KILL MSG,X
+15 SET BFLAG=1
End DoDot:3
End DoDot:2
End DoDot:1
+16 KILL BFLAG
+17 QUIT
