source: WorldVistAEHR/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKSITE.m@ 1766

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1SOWKSITE ;B'ham ISC/SAB Routine to set-up High Risk criteria and multi-divisional sites ; 01/09/92 12:10
2 ;;3.0; Social Work ;;27 Apr 93
3BEG R !!,"Do you want to: ",!,?5,"1 Edit Site Parameters",!,?5,"2 Enter/Edit a Reporting Site",!,"Enter 1, 2 or ""^"" to exit 1// ",SWSI:DTIME S:SWSI="" SWSI="1" G:"^"[SWSI!('$T) Q G:SWSI<1!(SWSI>2) BEG
4 I SWSI=2,'$D(^SOWK(650.1,1,0)) W !!,*7,"SOCIAL WORK SITE PARAMETERS MUST BE ADDED FIRST !!" D ADD,CHG G Q
5 I SWSI=2,$D(^SOWK(650.1,1,0)) D CHG G Q
6 D ADD G Q
7 Q
8ADD I $D(^SOWK(650.1,1,0)) S DA=1 D SP S DIE="^SOWK(650.1,",DR="[SOWKSITE]" W ! D ^DIE
9 I '$D(^SOWK(650.1,1,0)) S DA=1 D SP S ^SOWK(650.1,DA,0)=^DD("SITE"),^SOWK(650.1,"B",^DD("SITE"),DA)="",DIE="^SOWK(650.1,",DR="[SOWKSITE]" W ! D ^DIE S ^SOWK(650.1,0)=$P(^SOWK(650.1,0),"^",1,2)_"^"_DA_"^"_DA
10 Q
11Q K Y,ID,DIC,X,DA,DIE,DR,SWSI Q
12 Q
13CHG W ! S DIC("A")="SITE NAME: ",(DIE,DIC)="^SOWK(650.1,",DIC(0)="AEQML" D ^DIC G:"^"[X Q G:Y'>0 CHG S DA=+Y D SP S DIE="^SOWK(650.1,",DR="[SOWKSPF]" K DIC D ^DIE
14 Q
15SP ; ADD SPECIAL POPULATIONS THAT WILL BE REPORTED TO AUSTIN
16 S ^SOWK(650.1,DA,2,0)="^650.17I^4^4",SP(1)="SCI^01",SP(2)="HIV+/AIDS^02",SP(3)="NATIVE AMERICAN^03",SP(4)="HOMELESS^04"
17 S (DA(1),SITE)=DA,DIE="^SOWK(650.1,"_DA(1)_",2,",DR=".01///^S X=$P(SP(DA),""^"");1////^S X=$P(SP(DA),""^"",2)" F DA=1:1:4 D ^DIE
18 F ID=0:0 S ID=$O(^SOWK(650.1,SITE,2,ID)) Q:'ID S $P(^SOWK(650.1,SITE,2,0),"^",3)=ID,$P(^(0),"^",4)=ID
19 S DA=SITE K DIE,DR,X,Y,DA(1),SITE,SP,ID
20 Q
Note: See TracBrowser for help on using the repository browser.