source: FOIAVistA/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKCONV.m@ 1169

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

initial load of FOIAVistA 6/30/08 version

File size: 1.3 KB
Line 
1SOWKCONV ;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
14OUT W !!?10,"INITIALIZATION ROUTINE FINISHED !",!! K DA,SOWKOPT,SOWKPUR,Q,%,%Y,DIK,I,T,P,DIU,EX,ENT Q
15XREF 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
Note: See TracBrowser for help on using the repository browser.