source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDWLE111.m@ 1267

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1SDWLE111 ;;IOFO BAY PINES/TEH - WAITING LIST-ENTER/EDIT - WAIT LIST TYPE/INSTUTITION;20 Aug 2002
2 ;;5.3;scheduling;**263,273,280,394,417,485**;AUG 13 1993;Build 2
3 ;
4 ;
5 ;
6 ;******************************************************************
7 ; CHANGE LOG
8 ;
9 ; DATE PATCH DESCRIPTION
10 ; ---- ----- -----------
11 ;10/01/2002 263 Logical Order Change
12 ;12/02/2002 273 line EN2+19 add '/'
13 ;12/10/2004 SD*5.3*394 Add Service Connection prompts
14 ;01/11/2005 417 Permit MultiplePanels
15 ;02/16/2005 417 New logic for WAIT LIST TYPE Prompt. See Table in Release Notes.
16 ;
17 ;ASK WAIT LIST TYPE
18 ;
19EN ;
20 N SDWLPRP S (SDWLFLG,SDWLPRP)=0
21 D GETTM
22 I 'SDWLTEM S SDWLPRP=1
23 I SDWLTEM,'SDWLPOS S SDWLPRP=0
24 I $D(SDWLTY) W !,"Wait List Type: ",$$EXTERNAL^DILFD(409.3,4,,SDWLTY) W "// (No Editing)" S SDWLTYE=SDWLTY G EN10
25 ;10/01/2002 - TEH
26EN0 ;
27 I 'SDWLPRP D
28 .S DIR(0)="SO^1:PCMM TEAM ASSIGNMENT;2:PCMM POSITION ASSIGNMENT;3:SERVICE/SPECIALTY;4:SPECIFIC CLINIC"
29 .S DIR("L",1)=" Select Wait List Type: "
30 .S DIR("L",2)=""
31 .S DIR("L",3)=" 1. PCMM TEAM ASSIGNMENT"
32 .S DIR("L",4)=" 2. PCMM POSITION ASSIGNMENT"
33 .S DIR("L",5)=" 3. SERVICE/SPECIALTY"
34 .S DIR("L")=" 4. SPECIFIC CLINIC"
35 .S SDWLFLG=1
36 G EN9:SDWLFLG
37EN1 I SDWLPRP D
38 .S DIR(0)="SO^1:PCMM TEAM ASSIGNMENT;2:SERVICE/SPECIALTY;3:SPECIFIC CLINIC"
39 .S DIR("L",1)=" Select Wait List Type: "
40 .S DIR("L",2)=""
41 .S DIR("L",3)=" 1. PCMM TEAM ASSIGNMENT"
42 .S DIR("L",4)=" 2. SERVICE/SPECIALTY"
43 .S DIR("L")=" 3. SPECIFIC CLINIC"
44 .S SDWLFLG=0
45EN9 D ^DIR I X="" W " Required or '^' to Quit" G EN
46 I $D(DUOUT) S SDWLERR=1 G END
47 S SDWLTYE=+Y I 'SDWLFLG D
48 .S SDWLTYE=$S(+Y=1:1,+Y=2:3,+Y=3:4,1:0)
49 I 'SDWLTYE W " Invalid Entry." G EN
50 S DIE="^SDWL(409.3,",DR="4///^S X=SDWLTYE" D ^DIE
51 ;
52EN10 ;SERVICE CONNECTION - SD*5.3*394
53 ;
54 D ^SDWLSC
55 ;
56 ;ASK INSTITUTION (FILE 4)
57 ;
58 I SDWLTYE=2,$D(SDWLCPT),SDWLCPT S (SDWLINE,SDWLIN)=$P($G(^SCTM(404.51,+SDWLCPT,0)),U,7) G END
59 I SDWLTYE=2 S SDWLI=0 F S SDWLI=$O(^SCTM(404.57,SDWLI)) Q:SDWLI<1 D G END
60 .S SDWLL=+$P($G(^SCTM(404.57,SDWLI,0)),U,2),SDWLINL=+$P($G(^SCTM(404.51,+SDWLL,0)),U,7),SDWLINL(+SDWLINL)=""
61 K DUOUT S SDWLERR=0 W !
62 I $D(SDWLIN) D
63 .S X=$S($D(SDWLIN):$$EXTERNAL^DILFD(409.32,.02,,SDWLIN),1:""),SDWLINE=SDWLIN D
64 ..W !,"Select Institution: ",X," // (No Editing)" S SDWLERR=1
65 I SDWLERR S SDWLERR=0 G END
66 I SDWLTYE=1 S DIC("S")="I $D(^SCTM(404.51,""AINST"",+Y))"
67 I SDWLTYE=2 S DIC("S")="I $D(SDWLINL(+Y))"
68 I SDWLTYE=4 S DIC("S")="I $D(^SDWL(409.32,""ACT"",+Y))"
69 I SDWLTYE=3 S DIC("S")="I $D(^SDWL(409.31,""E"",+Y))"
70 S DIC("S")=DIC("S")_",$$GET1^DIQ(4,+Y_"","",11,""I"")=""N"",$$TF^XUAF4(+Y)"
71 S DIC(0)="AEQNM",DIC="4",DIC("A")="Select Institution: " D ^DIC I Y<0,'$D(DUOUT) S SDWLERR=1 W "Required or '^' to Quit."
72 I $D(DUOUT) S SDWLERR=1 Q
73 G EN10:SDWLERR
74 I Y>0 D
75 .K DIC,DIC("A"),DIC("S"),DIC(0),DIC("B") S (SDWLIN,SDWLINE)=+Y,DIE="^SDWL(409.3,"
76 .I '$D(DUOUT),Y>0 S DR="2////^S X=SDWLIN",DIE="^SDWL(409.3,",DA=SDWLDA D ^DIE
77 I $D(DUOUT) S SDWLERR=1
78END Q
79 ;
80 ;
81GETTM ;CHECK WAIT LIST FOR TEAM ASSIGNMENT.
82 Q:SDWLTEM Q:'$D(SDWLDFN) N SDWLDA1,SDWLX
83 S SDWLDA1=0 F S SDWLDA1=$O(^SDWL(409.3,"B",SDWLDFN,SDWLDA1)) Q:SDWLDA1<1 D
84 .S SDWLX=$G(^SDWL(409.3,SDWLDA1,0)) I $P(SDWLX,U,17)="O",$P(SDWLX,U,6) S SDWLTEM=1
85 K SDWLDA1
Note: See TracBrowser for help on using the repository browser.