|
Last change
on this file since 660 was 613, checked in by George Lilly, 15 years ago |
|
initial load of WorldVistAEHR
|
|
File size:
596 bytes
|
| Line | |
|---|
| 1 | SOWKSPP ;B'HAM ISC/DLR - Routine to delete duplicate entries in the SPP code field; 21 Oct 93 / 2:29 PM
|
|---|
| 2 | ;;3.0; Social Work ;**11**;27 Apr 93
|
|---|
| 3 | N XX,SP1,SP,X2,X3
|
|---|
| 4 | S XX=0,SP1="",SP("01")=1,SP("02")=2,SP("03")=3,SP("04")=4
|
|---|
| 5 | F S XX=$O(^SOWK(650.1,XX)) Q:XX="" D
|
|---|
| 6 | .S X2="" F S X2=$O(^SOWK(650.1,XX,2,"C",X2)) Q:X2="" D
|
|---|
| 7 | ..S X3="" F S X3=$O(^SOWK(650.1,XX,2,"C",X2,X3)) Q:X3="" D
|
|---|
| 8 | ...I $D(SP(X2)) I SP(X2)'=X3 W !,X2," is a duplicate code value for ",$P(^SOWK(650.1,XX,2,X3,0),U) S DA=X3,DA(1)=XX,DR=".01;1",DIE="^SOWK(650.1,"_DA(1)_",2," D ^DIE K DA,DR,DIE,DIC
|
|---|
| 9 | ...I '$D(SP(X2)) S SP(X2)=X3
|
|---|
| 10 | Q
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.
