1 | SOWCPOI ;B'HAM ISC/DLR - POST-INIT for 94 CDC account (651); 21 Dec 93 / 3:29 PM
|
---|
2 | V ;;3.0; Social Work ;**15,18**;27 Apr 93
|
---|
3 | POST ;POST-INIT
|
---|
4 | S (X,X2)=0
|
---|
5 | F S X=$O(^SOWK(651,"C",X)) Q:'X F S X2=$O(^(X,X2)) Q:'X2 S:$D(^TMP($J,"CDC",X,X2)) $P(^SOWK(651,X2,0),U,5)=^TMP($J,"CDC",X,X2)
|
---|
6 | K ^TMP($J,"CDC"),X,X2
|
---|
7 | CHECK ;check for valid clinics in the site parameter file
|
---|
8 | N INV,ENTRY,X1,X2
|
---|
9 | W !!,"Checking for invalid clinics.",! S INV=0
|
---|
10 | F X1=0:0 S X1=$O(^SOWK(650.1,X1)) Q:X1'>0 D
|
---|
11 | .F X2=0:0 S X2=$O(^SOWK(650.1,X1,4,X2)) Q:X2'>0 D
|
---|
12 | ..I $P(^SC(^(X2,0),0),U,3)'="C"!('$P(^(0),U,7)) W !,$P(^(0),U)_" is an invalid Clinic." S INV=1
|
---|
13 | I INV=1 D LV
|
---|
14 | I INV=0 W !!,"NO invalid Clinics were found!!!",! Q
|
---|
15 | ANS S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you wish to delete these invalid clinics now",DIR("?")="Enter ""YES"" to delete all invalid clinics or ""NO"" to continue with the initialization." D ^DIR K DIR,X Q:$D(DIRUT)!$D(DIROUT)!(Y'>0)
|
---|
16 | S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to delete all the invalid Clinics now ",DIR("?")="Enter ""YES"" to delete the clinics or ""NO"" to continue with the initialization." D ^DIR K X,DIR G:$D(DIRUT)!$D(DIROUT)!(Y'>0) ANS
|
---|
17 | F X1=0:0 S X1=$O(^SOWK(650.1,X1)) Q:X1'>0 D
|
---|
18 | .F X2=0:0 S X2=$O(^SOWK(650.1,X1,4,X2)) Q:X2'>0 D
|
---|
19 | ..I $P(^SC(^(X2,0),0),U,3)'="C"!('$P(^(0),U,7)) S ENTRY=X2 W !,$P(^(0),U)," is an INVALID CLINIC. Deleted ......" S DA=ENTRY,DIE="^SOWK(650.1,X1,4,",DR=".01///@",DA(1)=X1 D ^DIE K DA,DO,DIE
|
---|
20 | Q
|
---|
21 | LV W !!,"These entries need to be deleted or changed to avoid future problems. The"
|
---|
22 | W !,"invalid clinics in file (650.1 Clinic Subfile) can be deleted now or after the",!,"init process by running the routine CHECK^SOWCPOI at the programmer prompt.",!!!
|
---|
23 | Q
|
---|