source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCIREC.m@ 846

PRCIREC ;WISC/SWS-PRCIREC continued ;9/7/06  14:22
V       ;;5.1;IFCAP;**113**;Oct 20, 2000;Build 4
        ;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
        Q
START   S MYIEN=$P($G(^PRCH(440.6,DA,1)),U,1)
        I '$G(MYIEN) Q
        S VALUE2=$P($P($G(^PRC(442,MYIEN,0)),U,1),"-",2),VALUE3=0,BFLAG=0
        F  S VALUE3=$O(^PRCH(440.6,"C",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 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