source: WorldVistAEHR/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWCPOI.m@ 770

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1SOWCPOI ;B'HAM ISC/DLR - POST-INIT for 94 CDC account (651); 21 Dec 93 / 3:29 PM
2V ;;3.0; Social Work ;**15,18**;27 Apr 93
3POST ;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
7CHECK ;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
15ANS 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
21LV 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
Note: See TracBrowser for help on using the repository browser.