| [613] | 1 | SOWKTRAN ;B'HAM ISC/SAB-Routine to transfer RCH patients between homes ; 24 Feb 93 / 2:39 PM
|
|---|
| 2 | ;;3.0; Social Work ;;27 Apr 93
|
|---|
| 3 | S (DIE,DIC)="^SOWK(655,",DIC(0)="AEQMZ",DIC("A")="SELECT RCH PATIENT: ",DIC("S")="I $O(^SOWK(655,+Y,4,0))" D ^DIC G:Y<0 CLO K DIC
|
|---|
| 4 | S (SOWKRP,DA(1))=+Y F Q=0:0 S Q=$O(^SOWK(655,SOWKRP,4,Q)) Q:'Q S (SOWKLH,DA)=Q
|
|---|
| 5 | S DIE="^SOWK(655,"_DA(1)_",4,",DR="3"_"///"_1_";"_4_";"_6_"///"_1 D ^DIE S CN=$P(^SOWK(655,DA(1),4,DA,0),"^",5) I '$P(^(0),"^",4) S $P(^(0),"^",3)="",$P(^(0),"^",6)="" W !!,"INCOMPLETE TRANFER INFORMATION - PATIENT WAS NOT TRANSFERED" G CLO
|
|---|
| 6 | S DIC("S")="I $P(^SOWK(655,SOWKRP,4,SOWKLH,0),""^"",1)'=+Y",DIC="^SOWK(652,",DIC(0)="AQEMZ",DIC("A")="SELECT HOME: " D ^DIC I Y<0 W !!,"INCOMPLETE TRANFER INFORMATION - PATIENT WAS NOT TRANSFERED" G CLE
|
|---|
| 7 | S DA=+Y,(DIC,DIE)="^SOWK(655,"_DA(1)_",4,",DIC("DR")=".01;1;2;5"_"///"_CN,DIC(0)="L",(DA,X)=+Y K DD,DO D FILE^DICN I Y<0 W !!,"INCOMPLETE TRANFER INFORMATION - PATIENT WAS NOT TRANSFERED" G CLE
|
|---|
| 8 | CLO K DA,DR,DIC,DIE,Q,SOWKLH,SOWKRP,X,CN,Y
|
|---|
| 9 | Q
|
|---|
| 10 | CLE S $P(^SOWK(655,SOWKRP,4,SOWKLH,0),"^",3)="",$P(^(0),"^",4)="",$P(^(0),"^",6)="" G CLO
|
|---|
