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
|
Rev | Line | |
---|
[613] | 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.