| 1 | SOWKCONV ;B'HAM ISC/SAB-PRE-INIT ROUTINE ; 08/14/92 12:45
|
|---|
| 2 | ;;3.0; Social Work ;;27 Apr 93
|
|---|
| 3 | W ! I $G(SOWKPUR) D WAIT^DICD K ^SOWK(650),^SOWK(655) S ^SOWK(650,0)="SOCIAL WORK CASE^650OI^0^0",^SOWK(655,0)="SOCIAL WORK PATIENT^655OP^0^0" W "<CASE DATA PURGED>",!
|
|---|
| 4 | I $G(SOWKOPT) D ^SOWKOPT
|
|---|
| 5 | K DA F DIU=655.201,653 S DIU(0)="D" D EN^DIU2 K DA ;remove duplicate entries from file at test sites
|
|---|
| 6 | S DA=$O(^DIC(19,"B","SOWKCLOS",0)) I DA,$P(^DIC(19,DA,20),"^")]"" S DIK="^DIC(19," D ^DIK
|
|---|
| 7 | I $G(^SOWK(650.1,1,"VER"))<3 F DIU=653,656 S DIU(0)="" D EN^DIU2 K DIU S DIK="^DD(650,",DA=12 D ^DIK S DIU=651,DIU(0)="DT" D EN^DIU2
|
|---|
| 8 | I $G(^SOWK(650.1,1,"VER"))<3 F I=0:0 S I=$O(^SOWK(650.1,I)) Q:'I S $P(^SOWK(650.1,I,0),"^",2)=""
|
|---|
| 9 | K DA S DIU=655.01,DIU(0)="D" D EN^DIU2 S DIK="^DD(655,",DA(1)=655 F DA=8,9,10,11,12,13 D ^DIK
|
|---|
| 10 | S DIU=650.01,DIU(0)="S" D EN^DIU2
|
|---|
| 11 | I $G(^SOWK(650.1,1,"VER"))'<2.14 W !! G OUT
|
|---|
| 12 | W "." F I=0:0 S I=$O(^SOWK(656,I)) Q:'I S $P(^SOWK(656,I,2),"^",6)="" D XREF
|
|---|
| 13 | W "." S DA=3,DIK="^DD(656,",DA(1)=656 D ^DIK
|
|---|
| 14 | OUT W !!?10,"INITIALIZATION ROUTINE FINISHED !",!! K DA,SOWKOPT,SOWKPUR,Q,%,%Y,DIK,I,T,P,DIU,EX,ENT Q
|
|---|
| 15 | XREF I $P(^SOWK(656,I,4),"^"),$P(^(4),"^",2) K ^SOWK(656,"M",$P(^(4),"^"),I) S $P(^SOWK(656,I,4),"^")=$P(^DIC(5,$P(^SOWK(656,I,4),"^",2),1,$P(^(4),"^"),0),"^"),^SOWK(656,"M",$P(^SOWK(656,I,4),"^"),I)=""
|
|---|
| 16 | Q
|
|---|
