- SDWLCU2 ;IOFO BAY PINES/DMR - EWL FILE 409.3 CLEANUP ;2/4/03
- ;;5.3;scheduling;**280,1015**;AUG 13 1993;Build 21
- 1 ;
- S (TEAM,TEAMN,INST,NAME,SDWLERR)=""
- START ;
- F S INST=$O(^TMP($J,"SDWLCU1",1,INST)) Q:INST<1 D Q:SDWLERR=1
- .S TEAM="" F S TEAM=$O(^TMP($J,"SDWLCU1",1,INST,TEAM)) Q:TEAM<1 D Q:SDWLERR=1
- ..S TEAMN="" F S TEAMN=$O(^TMP($J,"SDWLCU1",1,INST,TEAM,TEAMN)) Q:TEAMN="" D Q:SDWLERR=1
- ...S NAME=$$GET1^DIQ(4,INST_",",.01)
- ...W !!,"Please enter a national institution!"
- ...W !,"TEAM: "_TEAMN_" "_"INSTITUTION: "_NAME
- ...S SDWLERR="" D EDIT Q:SDWLERR=1
- ...D UDWL
- Q
- EDIT ;
- S DIC(0)="AEQMNZ",DIC=4,DIC("S")="I $P(^(0),U,11)=""N"",$$TF^XUAF4(+Y)",DIC("A")="Select Institution: " D ^DIC
- I X["^" S SDWLERR=1 Q
- I Y<1 W " Select a New National Institution or '^' to quit." G EDIT
- CALL ;
- K SDTEAM S SDREC=+Y,SDWLIENS=TEAM_","
- S SDTEAM(404.51,SDWLIENS,.07)=SDREC
- D UPDATE^DIE("","SDTEAM","SDWLMSG")
- Q
- UDWL ;
- S IEN=""
- F S IEN=$O(^TMP($J,"SDWLCU1",1,INST,TEAM,TEAMN,IEN)) Q:IEN<1 D
- .S SDTEAM(409.3,IEN_",",2)=SDREC D UPDATE^DIE("","SDTEAM","SDWLMSG")
- .K ^TMP($J,"EWL",$J,IEN),^TMP($J,"SDWLCU1",1,INST,TEAM,TEAMN,IEN)
- S WLTC1=""
- Q
- 2 ;
- S (POS,POSNAM,INST,NAME,SDPOS,IEN,INST,SDWLERR)=""
- F S INST=$O(^TMP($J,"SDWLCU1",2,INST)) Q:INST<1 D Q:SDWLERR=1
- .S POS="" F S POS=$O(^TMP($J,"SDWLCU1",2,INST,POS)) Q:POS<1 D Q:SDWLERR=1
- ..S POSNAM="" F S POSNAM=$O(^TMP($J,"SDWLCU1",2,INST,POS,POSNAM)) Q:POSNAM="" D Q:SDWLERR=1
- ...S NAME=$$GET1^DIQ(4,INST_",",.01)
- ...W !!,"Please enter a national institution!"
- ...W !,"POSITION: "_POSNAM_" "_"INSTITUTION: "_NAME
- ...D EDIT2
- Q
- EDIT2 ;
- S DIC(0)="AEQMNZ",DIC=4,DIC("S")="I $P(^(0),U,11)=""N"",$$TF^XUAF4(+Y)",DIC("A")="Select Institution: " D ^DIC
- I X["^" S SDWLERR=1 Q
- I Y<1 W " Select a New National Institution or '^' to quit." G EDIT2
- CALL2 ;
- S TEAM=$$GET1^DIQ(404.57,POS_",",.02,"I")
- I TEAM>0 D CALL
- E W !,"Team missing in file 404.51 for",POSNAM
- K SDPOS S SDREC=+Y,SDWLIENS=POS_","
- S IEN=""
- F S IEN=$O(^TMP($J,"SDWLCU1",2,INST,POS,POSNAM,IEN)) Q:IEN<1 D
- .S SDPOS(409.3,IEN_",",2)=SDREC D UPDATE^DIE("","SDPOS","SDWLMSG")
- .K ^TMP($J,"EWL",$J,IEN),^TMP($J,"SDWLCU1",2,INST,POS,POSNAM,IEN)
- S WLTC2=""
- Q
- SDWLCU2 ;IOFO BAY PINES/DMR - EWL FILE 409.3 CLEANUP ;2/4/03
- +1 ;;5.3;scheduling;**280,1015**;AUG 13 1993;Build 21
- 1 ;
- +1 SET (TEAM,TEAMN,INST,NAME,SDWLERR)=""
- START ;
- +1 FOR
- SET INST=$ORDER(^TMP($JOB,"SDWLCU1",1,INST))
- IF INST<1
- QUIT
- Begin DoDot:1
- +2 SET TEAM=""
- FOR
- SET TEAM=$ORDER(^TMP($JOB,"SDWLCU1",1,INST,TEAM))
- IF TEAM<1
- QUIT
- Begin DoDot:2
- +3 SET TEAMN=""
- FOR
- SET TEAMN=$ORDER(^TMP($JOB,"SDWLCU1",1,INST,TEAM,TEAMN))
- IF TEAMN=""
- QUIT
- Begin DoDot:3
- +4 SET NAME=$$GET1^DIQ(4,INST_",",.01)
- +5 WRITE !!,"Please enter a national institution!"
- +6 WRITE !,"TEAM: "_TEAMN_" "_"INSTITUTION: "_NAME
- +7 SET SDWLERR=""
- DO EDIT
- IF SDWLERR=1
- QUIT
- +8 DO UDWL
- End DoDot:3
- IF SDWLERR=1
- QUIT
- End DoDot:2
- IF SDWLERR=1
- QUIT
- End DoDot:1
- IF SDWLERR=1
- QUIT
- +9 QUIT
- EDIT ;
- +1 SET DIC(0)="AEQMNZ"
- SET DIC=4
- SET DIC("S")="I $P(^(0),U,11)=""N"",$$TF^XUAF4(+Y)"
- SET DIC("A")="Select Institution: "
- DO ^DIC
- +2 IF X["^"
- SET SDWLERR=1
- QUIT
- +3 IF Y<1
- WRITE " Select a New National Institution or '^' to quit."
- GOTO EDIT
- CALL ;
- +1 KILL SDTEAM
- SET SDREC=+Y
- SET SDWLIENS=TEAM_","
- +2 SET SDTEAM(404.51,SDWLIENS,.07)=SDREC
- +3 DO UPDATE^DIE("","SDTEAM","SDWLMSG")
- +4 QUIT
- UDWL ;
- +1 SET IEN=""
- +2 FOR
- SET IEN=$ORDER(^TMP($JOB,"SDWLCU1",1,INST,TEAM,TEAMN,IEN))
- IF IEN<1
- QUIT
- Begin DoDot:1
- +3 SET SDTEAM(409.3,IEN_",",2)=SDREC
- DO UPDATE^DIE("","SDTEAM","SDWLMSG")
- +4 KILL ^TMP($JOB,"EWL",$JOB,IEN),^TMP($JOB,"SDWLCU1",1,INST,TEAM,TEAMN,IEN)
- End DoDot:1
- +5 SET WLTC1=""
- +6 QUIT
- 2 ;
- +1 SET (POS,POSNAM,INST,NAME,SDPOS,IEN,INST,SDWLERR)=""
- +2 FOR
- SET INST=$ORDER(^TMP($JOB,"SDWLCU1",2,INST))
- IF INST<1
- QUIT
- Begin DoDot:1
- +3 SET POS=""
- FOR
- SET POS=$ORDER(^TMP($JOB,"SDWLCU1",2,INST,POS))
- IF POS<1
- QUIT
- Begin DoDot:2
- +4 SET POSNAM=""
- FOR
- SET POSNAM=$ORDER(^TMP($JOB,"SDWLCU1",2,INST,POS,POSNAM))
- IF POSNAM=""
- QUIT
- Begin DoDot:3
- +5 SET NAME=$$GET1^DIQ(4,INST_",",.01)
- +6 WRITE !!,"Please enter a national institution!"
- +7 WRITE !,"POSITION: "_POSNAM_" "_"INSTITUTION: "_NAME
- +8 DO EDIT2
- End DoDot:3
- IF SDWLERR=1
- QUIT
- End DoDot:2
- IF SDWLERR=1
- QUIT
- End DoDot:1
- IF SDWLERR=1
- QUIT
- +9 QUIT
- EDIT2 ;
- +1 SET DIC(0)="AEQMNZ"
- SET DIC=4
- SET DIC("S")="I $P(^(0),U,11)=""N"",$$TF^XUAF4(+Y)"
- SET DIC("A")="Select Institution: "
- DO ^DIC
- +2 IF X["^"
- SET SDWLERR=1
- QUIT
- +3 IF Y<1
- WRITE " Select a New National Institution or '^' to quit."
- GOTO EDIT2
- CALL2 ;
- +1 SET TEAM=$$GET1^DIQ(404.57,POS_",",.02,"I")
- +2 IF TEAM>0
- DO CALL
- +3 IF '$TEST
- WRITE !,"Team missing in file 404.51 for",POSNAM
- +4 KILL SDPOS
- SET SDREC=+Y
- SET SDWLIENS=POS_","
- +5 SET IEN=""
- +6 FOR
- SET IEN=$ORDER(^TMP($JOB,"SDWLCU1",2,INST,POS,POSNAM,IEN))
- IF IEN<1
- QUIT
- Begin DoDot:1
- +7 SET SDPOS(409.3,IEN_",",2)=SDREC
- DO UPDATE^DIE("","SDPOS","SDWLMSG")
- +8 KILL ^TMP($JOB,"EWL",$JOB,IEN),^TMP($JOB,"SDWLCU1",2,INST,POS,POSNAM,IEN)
- End DoDot:1
- +9 SET WLTC2=""
- +10 QUIT
