source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLCU2.m@ 776

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1SDWLCU2 ;IOFO BAY PINES/DMR - EWL FILE 409.3 CLEANUP ;2/4/03
2 ;;5.3;scheduling;**280**;AUG 13 1993
31 ;
4 S (TEAM,TEAMN,INST,NAME,SDWLERR)=""
5START ;
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
15EDIT ;
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
19CALL ;
20 K SDTEAM S SDREC=+Y,SDWLIENS=TEAM_","
21 S SDTEAM(404.51,SDWLIENS,.07)=SDREC
22 D UPDATE^DIE("","SDTEAM","SDWLMSG")
23 Q
24UDWL ;
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
312 ;
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
41EDIT2 ;
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
45CALL2 ;
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
Note: See TracBrowser for help on using the repository browser.