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

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 800 bytes
Line 
1PRCIREC ;WISC/SWS-PRCIREC continued ;9/7/06 14:22
2V ;;5.1;IFCAP;**113**;Oct 20, 2000;Build 4
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;This routine serves as the input transform for the field Final Charge in File ^PRCH(440.6
5 Q
6START S MYIEN=$P($G(^PRCH(440.6,DA,1)),U,1)
7 I '$G(MYIEN) Q
8 S VALUE2=$P($P($G(^PRC(442,MYIEN,0)),U,1),"-",2),VALUE3=0,BFLAG=0
9 F S VALUE3=$O(^PRCH(440.6,"C",VALUE2,VALUE3)) Q:'VALUE3!(BFLAG=1) D
10 .I VALUE3'=DA D
11 ..I $P($G(^PRCH(440.6,VALUE3,1)),U,4)="Y" D
12 ...S BFLAG=1
13 ...K MSG
14 ...S MSG(1)="Sorry, there is already a final charge for this PC Order."
15 ...S MSG(2)="You need to remove the first final charge to continue."
16 ...S MSG(2,"F")="!"
17 ...S MSG(3)=""
18 ...S MSG(3,"F")="!"
19 ...D EN^DDIOL(.MSG)
20 ...K MSG,X
21 ...S BFLAG=1
22 K BFLAG
23 Q
Note: See TracBrowser for help on using the repository browser.