source: FOIAVistA/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKSPP.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 596 bytes
Line 
1SOWKSPP ;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.