[613] | 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
|
---|