Last change
on this file since 775 was 613, checked in by George Lilly, 15 years ago |
initial load of WorldVistAEHR
|
File size:
720 bytes
|
Line | |
---|
1 | PRCHFPD3 ;WASH-CIOFO/SC-FPDS INPUT TRANSFORM FROM FILE 420.6 ;7/24/00 23:06
|
---|
2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;This routine is only excutable at an entry point.
|
---|
5 | Q
|
---|
6 | EN1 ;Input Transform of Field #5 in File #420.6
|
---|
7 | N I,PRCLNGTH,PRCHBUS,ARR,J,PRCHTYP
|
---|
8 | K:$L(X)<1!($L(X)>30) X
|
---|
9 | Q:'$D(X)
|
---|
10 | S PRCLNGTH=$L(X)
|
---|
11 | F I=1:1:PRCLNGTH D
|
---|
12 | . S PRCHBUS=$E(X,I)
|
---|
13 | . I PRCHBUS=+PRCHBUS,1234[PRCHBUS D
|
---|
14 | . . S ARR(PRCHBUS)=""
|
---|
15 | . . Q
|
---|
16 | . Q
|
---|
17 | ;
|
---|
18 | ;Restore the proper values for Business Type and comma as a delimiter
|
---|
19 | ;for more than one Applicable Bus. Type for specific Socio. Group
|
---|
20 | ;
|
---|
21 | S J=""
|
---|
22 | S J=$O(ARR(J)) Q:J=""!(J'=+J)
|
---|
23 | S X=J
|
---|
24 | F S J=$O(ARR(J)) Q:J="" D
|
---|
25 | . S X=X_","_J
|
---|
26 | . Q
|
---|
27 | Q
|
---|
Note:
See
TracBrowser
for help on using the repository browser.