source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDWLRP2.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 3.5 KB
Line 
1SDWLRP2 ;;IOFO BAY PINES/TEH - WAITING LIST - RPC 2;06/28/2002 ; 20 Aug 2002 2:10 PM
2 ;;5.3;scheduling;**263**;AUG 13 1993
3 ;
4 ;
5 ;******************************************************************
6 ; CHANGE LOG
7 ;
8 ; DATE PATCH DESCRIPTION
9 ; ---- ----- -----------
10 ;
11 ;
12 ;
13OUTIN(SDWLOUT) ;List entries in INSTITUTION file (#4)
14 ;
15 ; Output:
16 ; SDWLOUT - The return reference
17 ;
18 ; ^TMP("SDWLRP2",$J,INSTITUTION IEN)=ZERO NODE DATA
19 ;
20 N SDWL1,SDWL2,SDWL3
21 K ^TMP("SDWLRP2",$J)
22 S U="^",SDWL1="" F S SDWL1=$O(^DIC(4,"B",SDWL1)) Q:SDWL1="" D
23 .S SDWL2="" F S SDWL2=$O(^DIC(4,"B",SDWL1,SDWL2)) Q:SDWL2="" D
24 ..S SDWL3=$G(^DIC(4,SDWL2,0)),^TMP("SDWLRP2",$J,SDWL1,SDWL2)=SDWL1_U_SDWL3
25 S SDWLOUT=$NA(^TMP("SDWLRP2",$J))
26 Q
27OUTSC0(SDWLOUT) ;List entries in CLINIC file (#409.32) - No Screen
28 ;
29 ; Output:
30 ; SDWLOUT = ^TMP("DILIST",$J)
31 ;
32 ; IEN^
33 ;
34 N DIERR
35 D LIST^DIC(409.32,,".01;","PS")
36 I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
37 K SDWLOUT S SDWLOUT=$NA(^TMP("DILIST",$J))
38 Q
39OUTSC1(SDWLOUT,SDWLIN) ;List entries in CLINIC file (#409.32) - Screen with Institution
40 ;
41 ; Output:
42 ; SDWLOUT = ^TMP("DILIST",$J)
43 ;
44 ; IEN^
45 ;
46 N SDWLDA,SDWLIN,SDWLSCR,DIERR
47 S SDWLSCR="I $P(^(0),U,6)=SDWLIN"
48 S SDWLDA=0 F S SDWLDA=$O(^SDWL(409.32,SDWLDA)) Q:SDWLDA<1 D
49 .S SDWLDAX="`"_SDWLDA
50 .D LIST^DIC(409.32,,".01;.02IE;1IE;2;3;4","PS",500,.SDWLDAX,,,.SDWLSCR)
51 I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
52 K SDWLOUT,SDWLDA,SDWLIN,SDWLSCR S SDWLOUT="^TMP(""DILIST"","_$J_")"
53 Q
54OUTSC2(SDWLOUT) ;List entries in HOSPITAL LOCATION FILE (#44)
55 ;
56 ; Output:
57 ; SDWLOUT = ^TMP("DILIST",$J)
58 ;
59 ; IEN^
60 ;
61 N DIERR
62 S SDWLSCR="I $E($P(^DIC(4,+Y,0),U,1),1,2)'=""ZZ"""
63 S SDWLDA=0 F S SDWLDA=$O(^SC(SDWLDA)) Q:SDWLDA<1 D
64 .S SDWLDAX="`"_SDWLDA
65 .D LIST^DIC(44,,".01","PS",500,.SDWLDAX,,,.SDWLSCR)
66 I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
67 K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
68 Q
69OUTST(SDWLOUT) ;List entries in Team File (#404.51)
70 ;
71 ; Output:
72 ; SCDWLOUT = ^TMP("DILIST",$J)
73 ;
74 ; IEN^NAME
75 ; 1 2
76 N DIERR
77 D LIST^DIC(404.51,,".01;","PS")
78 I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
79 K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
80 Q
81OUTSP(SDWLOUT) ;List entries in TEAM POSITION FILE (#404.57)
82 ;
83 ; Output:
84 ; SCDWLOUT = ^TMP("DILIST",$J)
85 ;
86 ; IEN^NAME
87 ; 1 2
88 N DIERR
89 D LIST^DIC(404.57,,"@;.01;","PS")
90 I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
91 K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
92 Q
93OUTSS(SDWLOUT) ;List entries in WL SERVICE/SPECIALTY file (#409.31)
94 ;
95 ; Output:
96 ; SCDWLOUT = ^TMP("DILIST",$J)
97 ;
98 ; IEN^NAME
99 ; 1 2
100 N DIERR
101 D LIST^DIC(409.31,,"@;.01;","PS")
102 I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
103 K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
104 Q
105OUTPROV(SDWLOUT) ;List entries in NEW PERSON FILE (#200) - Screen by Class
106 ;
107 ; Output:
108 ; SCDWLOUT = ^TMP("DILIST",$J)
109 ;
110 ; IEN^NAME
111 ; 1 2
112 ;
113 N SDWLDA,SDWLSCR,DIERR S SDWLSCR=""
114 S SDWLDA=0 F S SDWLDA=$O(^SCTM(404.51,SDWLDA)) Q:SDWLDA<1 D
115 .S SDWLDAX="`"_SDWLDA
116 .D LIST^DIC(404.51,,".01;","PS",,.SDWLDAX)
117 I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
118 K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
119 Q
120OUTSITE(SDWLOUT) ;return site name and number
121 ;
122 ; Output
123 ; SDWLOUT = SITE NAME^IE
124 S U="^"
125 S SDWLOUT=$P(^DIC(4,+$G(^DD("SITE",0)),0),U)_U_$G(^DD("SITE",0))
126 Q SDWLOUT
Note: See TracBrowser for help on using the repository browser.