source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCUTBK11.m@ 1446

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

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1SCUTBK11 ;ALB/SCK - Scheduling Broker Utilities; 2/2/96 ;9/7/96 17:28
2 ;;5.3;Scheduling;**41,54,86,148,177,205,209,255,297**;AUG 13, 1993
3 ;
4 Q
5PARSE(SC) ;
6 S SCDFN=$G(SC("DFN"),"")
7 S SCPIEN=$G(SC("PIEN"),"")
8 S:$D(SC("TEAM")) SCTM=$G(SC("TEAM"))
9 S:$D(SC("BEGIN")) SCDT("BEGIN")=$G(SC("BEGIN"))
10 S:$D(SC("END")) SCDT("END")=$G(SC("END"))
11 I $D(SC("END")) S SCDT("INCL")=0
12 S SCFILE=$G(SC("FILE"))
13 S SCIEN=$G(SC("IEN"))
14 S SCFIELD=$G(SC("FIELD"))
15 S SCVAL=$G(SC("VALUE"))
16 Q
17 ;
18TMLST(SCDATA,SC) ;
19 ; -- Return a list of teams for a patient. Pass in the DFN and
20 ; optionally a date range and/or a team purpose to restrict the
21 ; team look up. Return only the team entry, strip out any other
22 ; array items.
23 ;
24 N DFN,SCDT,SCPURP,SCLIST,SCER1,SCOK,SCD
25 ;
26 D CHK^SCUTBK
27 D TMP^SCUTBK
28 ;
29 S DFN=$G(SC("DFN"))
30 S SCDT("BEGIN")=$G(SC("BEGIN"),"")
31 I $L(SCDT("BEGIN"))>2 S SCDT("INCL")=$G(SC("INCL"),0)
32 S SCDT("END")=$G(SC("END"),"")
33 S SCPURP=$G(SC("PURP"),"")
34 ;
35 S SCOK=$$TMPT^SCAPMC3(DFN,"SCDT","","SCD","SCER1")
36 ;
37 S I=0 F S I=$O(SCD(I)) Q:'I S SCDATA(I)=SCD(I)
38TMQ Q
39 ;
40FINDP(SCOUT,SCIN) ; patient lookup used by SC PATIENT LOOKUP rpc
41 ; input:
42 ; SCIN("VALUE") = value to lookup
43 ; Lookup uses multiple index lookup of File #2
44 ; output:
45 ; SCOUT = location of data = ^TMP("DILIST",$J,i,0)
46 ; for i=1:number of records returned:
47 ; DFN^patient name^DOB^PID^DOD
48 ; 1 2 3 4 5
49 ;
50 ;bp/cmf 205 original code next line
51 ;D FIND^DIC(2,,".01;.03;.363;.09","MPS",SCIN("VALUE"),500)
52 ;bp/cmf 205 change code next line
53 ;oifo/swo 297 added .351 for DOD warning new functionality
54 D FIND^DIC(2,,".01;.03;.363;.09;.351","PS",SCIN("VALUE"),300,"B^BS^BS5^SSN")
55 I $G(DIERR) D CLEAN^DILF Q
56 N SCOUNT S SCOUNT=+^TMP("DILIST",$J,0)
57 N SC F SC=1:1:SCOUNT D
58 . N NODE,SSN,DSSN,PLID
59 . S NODE=^TMP("DILIST",$J,SC,0)
60 . ;Apply DOB screen
61 . S $P(NODE,U,3)=$$DOB^DPTLK1(+NODE)
62 . ;Apply SSN screen
63 . S SSN=$$SSN^DPTLK1(+NODE)
64 . S DSSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,11)
65 . S PLID=$P(NODE,U,4)
66 . I $E(SSN,1,9)'?9N S (DSSN,PLID)=SSN
67 . S $P(NODE,U,4)=$S($L(PLID)>5:PLID,1:DSSN)
68 . ;Move screened data back into output global
69 . ;oifo/swo 297 piece 6 is DOD field. Added for DOD warning
70 . S ^TMP("DILIST",$J,SC,0)=$P(NODE,U,1,4)_U_$P(NODE,U,6)
71 K ^TMP("DILIST",$J,0)
72 K SCOUT S SCOUT="^TMP(""DILIST"","_$J_")"
73 Q
74PSLST(SCDATA,SC) ;
75 ;
76 ; - Returns a array of positions that show the person currently
77 ; assigned to the position, the preceptor for that position,
78 ; for the patient is assigned to.
79 ;
80 ; Pass in the Patient's DFN
81 ; To restrict to specific entries, pass in the following:
82 ; Beginning and Ending Date Range
83 ; A specific Team Position
84 ; A Specific User entry (8930)
85 ; A specific Team Purpose. (Read SCAPMC23 for how it exclude
86 ; a specific team purpose.
87 ; A specific role
88 ; Flag whether to include patients associated by enrollement
89 ;
90 N SCDT,SCD,SCER1,SCDFN,SCPRP,SCPST,SCRLE,SCIND,SCUSR,SCTM,SCDTE
91 ;
92 D CHK^SCUTBK
93 D TMP^SCUTBK
94 ;
95 D PARSE(.SC)
96 S SCDTE=$G(SCDT("BEGIN"))
97 ;
98 S CNT=0
99 K ^TMP($J,"PSLST")
100 S SCOK=$$TPPT^SCAPMC(SCDFN,.SCDT,"","","","","","SCD","SCER1")
101 S I=0 F S I=$O(SCD(I)) Q:'I D
102 . I $D(SCTM) D
103 .. Q:$P(SCD(I),U,3)'=SCTM
104 .. S ^TMP($J,"PSLST",I)=$P($G(SCD(I)),U,3)_U_$P($G(SCD(I)),U,4)_U_$P($G(SCD(I)),U,1,2)_U_$P($G(SCD(I)),U,7,8)
105 . ;
106 . I '$D(SCTM) D
107 .. S ^TMP($J,"PSLST",I)=$P($G(SCD(I)),U,3)_U_$P($G(SCD(I)),U,4)_U_$P($G(SCD(I)),U,1,2)_U_$P($G(SCD(I)),U,7,8)
108 ;
109 S CNT=0
110 S I=""
111 F S I=$O(^TMP($J,"PSLST",I)) Q:'I D
112 . S:'$D(SCDTE) SCDTE=DT
113 . S SCPIEN=$P($G(^TMP($J,"PSLST",I)),U,3)
114 . S SCDATA(CNT)=^TMP($J,"PSLST",I)_U_$$PSMBR(SCPIEN,SCDTE)_U_+$P($G(^SCPT(404.43,$P($G(^TMP($J,"PSLST",I)),U,2),0)),U,5)_U_+$P($G(^SCTM(404.57,SCPIEN,0)),U,4)
115 . S CNT=CNT+1
116 K ^TMP($J,"PSLST")
117 ;
118PSLTQ Q
119 ;
120PSMBR(SCPIEN,SCPDT) ;
121 ;
122 N SCPRCP,SCMBR,SCPP
123 ;
124 S SCMBR=$$GETPRTP^SCAPMCU2(SCPIEN,SCPDT)
125 S SCMBR=$S(+SCMBR>0:SCMBR,1:U)
126 S SCPP=$$OKPREC2^SCMCLK(SCPIEN,SCPDT)
127 S SCPRCP=$S(+SCPP>0:SCPP,1:U)
128 Q SCMBR_U_SCPRCP
129 ;
130VFILE(SCOK,SC) ;
131 N SCFILE,SCIEN,SCFIELD,SCVAL,SCFDA,SCMSG
132 ;
133 D CHK^SCUTBK
134 D TMP^SCUTBK
135 ;
136 S SCOK=1
137 D PARSE(.SC)
138 S SCFDA(SCFILE,""_SCIEN_","_"",SCFIELD)=SCVAL
139 ;
140 D FILE^DIE("K","SCFDA","SCMSG")
141 ;
142 I $D(SCMSG("DIERR")) D
143 . S SCOK=0
144 Q
145 ;
146SECKEY(SCOK,SCKEY) ;
147 ;
148 D CHK^SCUTBK
149 ;
150 S SCOK=$D(^XUSEC(SCKEY,DUZ))
151 Q
152 ;
153PSALST(SCDATA,SC) ;
154 ;
155 ; - Returns a array of positions that show the person currently
156 ; assigned to the position, the preceptor for that position,
157 ; for the patient is assigned to.
158 ;
159 ; Pass in the Patient's DFN
160 ; To restrict to specific entries, pass in the following:
161 ; Beginning and Ending Date Range
162 ; A specific Team Position
163 ; A Specific User entry (8930)
164 ; A specific Team Purpose. (Read SCAPMC23 for how it exclude
165 ; a specific team purpose.
166 ; A specific role
167 ; Flag whether to include patients associated by enrollement
168 ;
169 N SCDT,SCD,SCER1,SCDFN,SCPRP,SCPST,SCRLE,SCIND,SCUSR,SCTM,SCDTE,SCPTTMA
170 ;
171 D CHK^SCUTBK
172 D TMP^SCUTBK
173 ;
174 D PARSE(.SC)
175 S SCPTTMA=$G(SC("TEAMASSIGN")) ;NEW JLU
176 S SCDTE=$G(SCDT("BEGIN"),DT) ;bp/cmf 177 added DT for gui
177 ;
178 S CNT=0
179 K ^TMP($J,"PSLST")
180 S SCOK=$$TPPT^SCAPMC(SCDFN,.SCDT,"","","","","","SCD","SCER1")
181 S I=0 F S I=$O(SCD(I)) Q:'I D
182 .Q:$P(SCD(I),U,11)'=SCPTTMA
183 .S ^TMP($J,"PSLST",I)=$P($G(SCD(I)),U,3)_U_$P($G(SCD(I)),U,4)_U_$P($G(SCD(I)),U,1,2)_U_$P($G(SCD(I)),U,7,8)
184 ;
185 S CNT=0
186 S I=""
187 F S I=$O(^TMP($J,"PSLST",I)) Q:'I D
188 . S:'$D(SCDTE) SCDTE=DT
189 . S SCPIEN=$P($G(^TMP($J,"PSLST",I)),U,3)
190 . S SCDATA(CNT)=^TMP($J,"PSLST",I)_U_$$PSMBR(SCPIEN,SCDTE)_U_+$P($G(^SCPT(404.43,$P($G(^TMP($J,"PSLST",I)),U,2),0)),U,5)_U_+$P($G(^SCTM(404.57,SCPIEN,0)),U,4)
191 . S CNT=CNT+1
192 K ^TMP($J,"PSLST")
193 ;
194PSALSTQ Q
Note: See TracBrowser for help on using the repository browser.