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
