| 1 | SOWKDBEN ;B'HAM ISC/SAB-Routine to enter/edit notes (closing,dicharge planning) ; 01/06/92 15:30 [ 09/22/94 7:44 AM ]
|
|---|
| 2 | ;;3.0; Social Work ;**34**;27 Apr 93
|
|---|
| 3 | SE K DIC S DIC("S")="I $D(^SOWK(650,""W"",DUZ,+Y))",DIC="^SOWK(650,",DIC(0)="AEQMZ",DIC("A")="SELECT CASE: " D ^DIC G:"^"[$E(X) CLOS G:Y<1 SE S DA=+Y,C=^SOWK(650,DA,0),PN=$P(C,"^"),SWPT=$P(C,"^",8),SWSW=$P(C,"^",3) K DIC("A")
|
|---|
| 4 | I '$D(^SOWK(655.2,SWPT)) G BEG1
|
|---|
| 5 | I '$D(^SOWK(655.2,SWPT,23,"AG",PN)) G BEG
|
|---|
| 6 | S DA(1)=SWPT,DIE="^SOWK(655.2,"_DA(1)_",23," S DA=$O(^SOWK(655.2,SWPT,23,"AG",PN,0))
|
|---|
| 7 | ED W @IOF G:$G(TYPE)=1 ED1 S DR=$S($G(TYPE)=2:"18;2;3;4///^S X=""T""",$G(TYPE)=3:"18;6;5;7///^S X=""T""",1:"") D ^DIE W @IOF G SE
|
|---|
| 8 | ED1 S:'$D(^SOWK(655.2,SWPT,17,0)) ^SOWK(655.2,SWPT,17,0)="^655.38PA^0^0"
|
|---|
| 9 | S DA=SWPT,DIE="^SOWK(655.2,",DR=17,DR(2,655.38)=".01;2" D ^DIE K DR S DR="17.1///^S X=""T""" D ^DIE W @IOF G SE
|
|---|
| 10 | CLOS K PN,SWPT,TYPE,SWSW,DFN,DIC,DIE,Y,X,DA,DR,C,SUP,SWWRK,DINUM
|
|---|
| 11 | Q
|
|---|
| 12 | BEG I '$D(^SOWK(655.2,SWPT,23,0)) S ^SOWK(655.2,SWPT,23,0)="^655.218PA^0^0"
|
|---|
| 13 | S (DA,X)=$P(^SOWK(655.2,SWPT,23,0),"^",3)+1
|
|---|
| 14 | S DA(1)=SWPT,(DIE,DIC)="^SOWK(655.2,"_DA(1)_",23,",DIC("DR")=".01///"_SWSW_";1///"_PN,DIC(0)="L"
|
|---|
| 15 | D:'$D(^SOWK(655.2,DA(1),23,"AG",PN)) FILE^DICN K DIC("DR") G:$D(TYPE) ED
|
|---|
| 16 | Q
|
|---|
| 17 | BEG1 D WAIT^DICD K DIC S SUP=$P(^VA(200,$P(C,"^",3),654),"^",2),SWWRK=$P(C,"^",3)
|
|---|
| 18 | S (DINUM,DA,X)=SWPT,DIC(0)="L",DIC="^SOWK(655.2,",DIC("DR")=".03////"_SWWRK_";.04////"_SUP_";.031////"_$P(C,"^")_";.02///"_DT K DD,DO D FILE^DICN S DA=+Y,DFN=SWPT D BEG Q:'$G(TYPE) D ED
|
|---|
| 19 | Q
|
|---|
