source: WorldVistAEHR/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKDBEN.m@ 1259

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

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1SOWKDBEN ;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
3SE 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))
7ED 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
8ED1 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
10CLOS K PN,SWPT,TYPE,SWSW,DFN,DIC,DIE,Y,X,DA,DR,C,SUP,SWWRK,DINUM
11 Q
12BEG 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
17BEG1 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
Note: See TracBrowser for help on using the repository browser.