| 1 | SOWKDBSR ;B'HAM ISC/SAB-Routine to add/delete surrogate supervisor ; 11/08/91 11:57
|
|---|
| 2 | ;;3.0; Social Work ;;27 Apr 93
|
|---|
| 3 | W ! S DIC("S")="I $D(^VA(200,+Y,654)),$P(^VA(200,+Y,654),""^""),$D(^VA(200,""ASWE"",+Y))",(DIE,DIC)="^VA(200,",DIC("A")="SELECT SURROGATE SUPERVISOR: ",DIC(0)="AEMQZ" D ^DIC G:"^"[X CLO G:Y<0 SOWKDBSR S SUR=+Y
|
|---|
| 4 | SUR W !! S DIC("S")="I $D(^VA(200,""ASWE"",+Y)),+Y'=SUR",DIC("A")="SELECT SURROGATED SUPERVISOR: " D ^DIC G:"^"[X CLO G:Y<0 SUR S DA=+Y
|
|---|
| 5 | I DA=SUR W *7,!,"YOU CANNOT BE YOUR OWN SURROGATE !" G TRY
|
|---|
| 6 | E D ADD G CLO
|
|---|
| 7 | CLO K SOWKNEW,DA,%,%Y,Q,SUR,DIC,X,DIE,DR,I,PA,Y Q
|
|---|
| 8 | ADD S SOWKNEW=1,DR="654.3///^S X=SUR" D ^DIE K DIC S DIE="^SOWK(655.2,",PA=DA,DR=".05////"_SUR F I=0:0 S I=$O(^SOWK(655.2,"E",PA,I)) Q:'I S DA=I W "." D ^DIE
|
|---|
| 9 | S SOWKNEW=1,DR="654.3///^S X=SUR",DIE="^VA(200," F I=0:0 S I=$O(^VA(200,"ACSW",PA,I)) Q:'I S DA=I D ^DIE
|
|---|
| 10 | Q
|
|---|
| 11 | TRY K DA F Q=0:0 W !!,"DO YOU WANT TO TRY AGAIN" S %=2 D YN^DICN Q:% I %Y="?" D YN^SOWKHELP
|
|---|
| 12 | G:%=2!(%=-1) CLO
|
|---|
| 13 | G SUR
|
|---|
| 14 | Q
|
|---|
| 15 | DEL S DR="654.3///@",(DIE,DIC)="^VA(200,",DIC("A")="SELECT SURROGATE SUPERVISOR: ",DIC(0)="AEQMZ",DIC("S")="I $D(^VA(200,""ACSW"",+Y))" D ^DIC G:"^"[X CLO G:Y<0 DEL S SUR=+Y
|
|---|
| 16 | DE S DIC("A")="SELECT SURROGATED SUPERVISOR: ",DIC("S")="I $P(^(0),""^"",4)'=+Y,$D(^VA(200,""ACSW"",SUR,+Y)),$D(^VA(200,""ASWE"",+Y))" D ^DIC G:"^"[X CLO G:Y<0 DE S DA=+Y D ^DIE
|
|---|
| 17 | K DIC S DIE="^SOWK(655.2,",PA=DA,DR=".05///@" F I=0:0 S I=$O(^SOWK(655.2,"E",PA,I)) Q:'I S DA=I D ^DIE W "."
|
|---|
| 18 | S DR="654.3///@",DIE="^VA(200," F I=0:0 S I=$O(^VA(200,"ACSW",SUR,I)) Q:'I S DA=I I PA=I!$P(^VA(200,I,654),"^",4)=SUR D ^DIE
|
|---|
| 19 | G CLO
|
|---|
| 20 | Q
|
|---|
