1 | SDWLCU2 ;IOFO BAY PINES/DMR - EWL FILE 409.3 CLEANUP ;2/4/03
|
---|
2 | ;;5.3;scheduling;**280**;AUG 13 1993
|
---|
3 | 1 ;
|
---|
4 | S (TEAM,TEAMN,INST,NAME,SDWLERR)=""
|
---|
5 | START ;
|
---|
6 | F S INST=$O(^TMP($J,"SDWLCU1",1,INST)) Q:INST<1 D Q:SDWLERR=1
|
---|
7 | .S TEAM="" F S TEAM=$O(^TMP($J,"SDWLCU1",1,INST,TEAM)) Q:TEAM<1 D Q:SDWLERR=1
|
---|
8 | ..S TEAMN="" F S TEAMN=$O(^TMP($J,"SDWLCU1",1,INST,TEAM,TEAMN)) Q:TEAMN="" D Q:SDWLERR=1
|
---|
9 | ...S NAME=$$GET1^DIQ(4,INST_",",.01)
|
---|
10 | ...W !!,"Please enter a national institution!"
|
---|
11 | ...W !,"TEAM: "_TEAMN_" "_"INSTITUTION: "_NAME
|
---|
12 | ...S SDWLERR="" D EDIT Q:SDWLERR=1
|
---|
13 | ...D UDWL
|
---|
14 | Q
|
---|
15 | EDIT ;
|
---|
16 | S DIC(0)="AEQMNZ",DIC=4,DIC("S")="I $P(^(0),U,11)=""N"",$$TF^XUAF4(+Y)",DIC("A")="Select Institution: " D ^DIC
|
---|
17 | I X["^" S SDWLERR=1 Q
|
---|
18 | I Y<1 W " Select a New National Institution or '^' to quit." G EDIT
|
---|
19 | CALL ;
|
---|
20 | K SDTEAM S SDREC=+Y,SDWLIENS=TEAM_","
|
---|
21 | S SDTEAM(404.51,SDWLIENS,.07)=SDREC
|
---|
22 | D UPDATE^DIE("","SDTEAM","SDWLMSG")
|
---|
23 | Q
|
---|
24 | UDWL ;
|
---|
25 | S IEN=""
|
---|
26 | F S IEN=$O(^TMP($J,"SDWLCU1",1,INST,TEAM,TEAMN,IEN)) Q:IEN<1 D
|
---|
27 | .S SDTEAM(409.3,IEN_",",2)=SDREC D UPDATE^DIE("","SDTEAM","SDWLMSG")
|
---|
28 | .K ^TMP($J,"EWL",$J,IEN),^TMP($J,"SDWLCU1",1,INST,TEAM,TEAMN,IEN)
|
---|
29 | S WLTC1=""
|
---|
30 | Q
|
---|
31 | 2 ;
|
---|
32 | S (POS,POSNAM,INST,NAME,SDPOS,IEN,INST,SDWLERR)=""
|
---|
33 | F S INST=$O(^TMP($J,"SDWLCU1",2,INST)) Q:INST<1 D Q:SDWLERR=1
|
---|
34 | .S POS="" F S POS=$O(^TMP($J,"SDWLCU1",2,INST,POS)) Q:POS<1 D Q:SDWLERR=1
|
---|
35 | ..S POSNAM="" F S POSNAM=$O(^TMP($J,"SDWLCU1",2,INST,POS,POSNAM)) Q:POSNAM="" D Q:SDWLERR=1
|
---|
36 | ...S NAME=$$GET1^DIQ(4,INST_",",.01)
|
---|
37 | ...W !!,"Please enter a national institution!"
|
---|
38 | ...W !,"POSITION: "_POSNAM_" "_"INSTITUTION: "_NAME
|
---|
39 | ...D EDIT2
|
---|
40 | Q
|
---|
41 | EDIT2 ;
|
---|
42 | S DIC(0)="AEQMNZ",DIC=4,DIC("S")="I $P(^(0),U,11)=""N"",$$TF^XUAF4(+Y)",DIC("A")="Select Institution: " D ^DIC
|
---|
43 | I X["^" S SDWLERR=1 Q
|
---|
44 | I Y<1 W " Select a New National Institution or '^' to quit." G EDIT2
|
---|
45 | CALL2 ;
|
---|
46 | S TEAM=$$GET1^DIQ(404.57,POS_",",.02,"I")
|
---|
47 | I TEAM>0 D CALL
|
---|
48 | E W !,"Team missing in file 404.51 for",POSNAM
|
---|
49 | K SDPOS S SDREC=+Y,SDWLIENS=POS_","
|
---|
50 | S IEN=""
|
---|
51 | F S IEN=$O(^TMP($J,"SDWLCU1",2,INST,POS,POSNAM,IEN)) Q:IEN<1 D
|
---|
52 | .S SDPOS(409.3,IEN_",",2)=SDREC D UPDATE^DIE("","SDPOS","SDWLMSG")
|
---|
53 | .K ^TMP($J,"EWL",$J,IEN),^TMP($J,"SDWLCU1",2,INST,POS,POSNAM,IEN)
|
---|
54 | S WLTC2=""
|
---|
55 | Q
|
---|