source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDUTL2.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: 8.2 KB
Line 
1SDUTL2 ;ALB/CAW - Misc. utilities ; 6/28/07 11:48am
2 ;;5.3;Scheduling;**20,71,132,149,175,193,220,258,380,516**;Aug 13, 1993;Build 3
3 ;
4 ;
5FYNUNK(SD) ; return YES, NO, UNKNOWN
6 ; input: SD=internal piece
7 ; output: [returned] Y=YES, N=NO, U=UNKNOWN
8 Q $S(SD="Y":"YES",SD="N":"NO",SD="U":"UNKNOWN",1:"")
9 ;
10FMT(DFN) ; return current status of means test in external form
11 ; input: DFN=ifn of patient
12 ; ouput: [returned] MT^SMT^LST
13 ; MT=external format of current status
14 ; SMT=shortened format of current staus
15 ; LST=date of last test
16 ;
17 N X,Y
18 S X=$$LST^DGMTU(DFN)
19 S Y=$P(X,U,4),Y=$S(Y["B":"CAT "_Y,Y["A":"COPAY EX",Y["C":"COPAY REQ",Y["G":"GMT COPAY REQ",Y["R":"REQ",Y["P":"PEND ADJ",Y["N":"NOT REQ",1:"")
20 Q $P(X,U,3)_U_Y_U_$P(X,U,2)
21 ;
22FCO(DFN) ; return current status of copay test in external form
23 ; input: DFN=ifn of patient
24 ; ouput: [returned] COT^SCOT^LST
25 ; COT=external format of current status
26 ; SCOT=shortened format of current staus
27 ; LST=date of last test
28 ;
29 N X,Y
30 S X=$$LST^DGMTU(DFN,"",2)
31 S Y=$P(X,U,4),Y=$S(Y["E":"EXEMPT",Y["M":"NON-EXEMPT",Y["I":"INCOMPLETE",Y["L":"NO LONGER APPL.",1:"")
32 Q $P(X,U,3)_U_Y_U_$P(X,U,2)
33 ;
34XMY(GROUP,SDUZ,SDPOST) ; -- set up XMY for mail group members
35 ; input: GROUP := mail group efn [required]
36 ; SDUZ := send to current user [ 0|no ; 1|yes] [optional]
37 ; SDPOST := send to postmaster if XMY is undefined
38 ; [ 0|no ; 1|yes] [optional]
39 ; output: XMY := array of users
40 ; XMDUZ := message sender set postmaster
41 ;
42 N I K XMY
43 I '$D(SDUZ) N SDUZ S SDUZ=1
44 I '$D(SDPOST) N SDPOST S SDPOST=1
45 S XMY("G."_$P($G(^XMB(3.8,GROUP,0)),U))=""
46 I SDUZ,DUZ S XMY(DUZ)=""
47 ; makes sure it gets sent to someone
48 I '$D(XMY),SDPOST S XMY(.5)=""
49 ; make postmaster the sender so it will show up as new to DUZ
50 S XMDUZ=.5
51 Q
52 ;
53SCREEN(Y,SDDT) ; -- screen called when entering a provider in the
54 ; DEFAULT PROVIDER field (#16) or PROVIDER field (#.01) of the PROVIDER
55 ; multiple (#2600) in the HOSPITAL LOCATION file (#44).
56 ;
57 ; Selects active providers with an active entry in the NEW PERSON
58 ; file (#200) for PERSON CLASS.
59 ;
60 ; INPUT: Y = ien of file 200
61 ; SDDT = today's date
62 ; OUTPUT: 1 to select; 0 to not select
63 ;
64 ; begin patch *516*
65 ; DBIA #2349 - ACTIVE PROVIDER will be used for validation.
66 ; The INACTIVE DATE (#53.4) field will no longer be used.
67 ; New input selection logic...
68 ; The TERMINATION DATE (#9.2) and the PERSON CLASS (#8932.1) fields
69 ; will be used to determine if selection is active in the
70 ; NEW PERSON (#200) file for a given date.
71 ;
72 ;S:'+$G(SDDT) SDDT=DT I '+$G(Y) Q 0
73 ;N SDINACT,SDT,SDY S SDY=0
74 ; check if provider active
75 ;S SDINACT=$G(^VA(200,+Y,"PS"))
76 ;Q:'$S(SDINACT']"":1,'+$P(SDINACT,"^",4):1,DT<+$P(SDINACT,"^",4):1,1:0) SDY
77 ;S SDT=+$P($G(^VA(200,+Y,0)),U,11)
78 ;Q:$S('SDT:0,(SDT<DT):1,1:0) 0
79 ;I $$GET^XUA4A72(Y,SDDT)>0 S SDY=1
80 ;
81 I '+$G(Y) Q 0
82 N SDY
83 S:'+$G(SDDT) SDDT=DT
84 S SDY=0,SDDT=$P(SDDT,".")
85 I $$ACTIVPRV^PXAPI(+Y,SDDT) S SDY=1 ;DBIA #2349
86 ; end patch *516*
87 Q SDY
88 ;
89HELP(SDDT) ; -- executable help called when entering a provider in the
90 ; DEFAULT PROVIDER field (#16) or PROVIDER field (#.01) of the PROVIDER
91 ; multiple (#2600) in the HOSPITAL LOCATION file (#44), the PROVIDER
92 ; (#.01) field of the V PROVIDER file (#9000010.06), or in the
93 ; PROVIDER prompt of the Check-out screen. display active providers
94 ; with an active entry in the NEW PERSON file (#200) for PERSON CLASS.
95 ;
96 ; INPUT: SDDT = today's date
97 ; OUTPUT: display of active providers with an active entry in the NEW
98 ; PERSON file (#200) for PERSON CLASS
99 ;
100 S:'+$G(SDDT) SDDT=DT
101 N D,DO,DIC,X
102 S X="??",DIC="^VA(200,",DIC(0)="EQ",D="B"
103 S DIC("S")="I $$SCREEN^SDUTL2(Y,SDDT)"
104 D IX^DIC
105 Q
106 ;
107SCAN(SDINDEX,SDBEG,SDEND,SDCB,SDFN,SDIR) ; -- api to invoke scan
108 N SDQID
109 D OPEN^SDQ(.SDQID)
110 D INDEX^SDQ(.SDQID,SDINDEX,"SET")
111 IF SDINDEX="PATIENT/DATE"!(SDINDEX="PATIENT") D PAT^SDQ(.SDQID,SDFN,"SET")
112 IF SDINDEX="PATIENT/DATE"!(SDINDEX="DATE/TIME") D DATE^SDQ(.SDQID,SDBEG,SDEND,"SET")
113 D SCANCB^SDQ(.SDQID,SDCB,"SET")
114 D ACTIVE^SDQ(.SDQID,"TRUE","SET")
115 D SCAN^SDQ(.SDQID,SDIR)
116 D CLOSE^SDQ(.SDQID)
117SCANQ Q
118 ;
119MHCLIN(SDCL,SDSC) ;;Determines if Mental health Clinic requiring GAF
120 ;;This will be a supported call
121 ;;Determines whether the clinic passed is a Mental Health clinic that requires Gaf
122 ;;Input - SDCL = Clinic IEN
123 ;; SDSC = DSS Stop Code [Optional]
124 ;; For Visit File entries where the Clinic IEN is not available
125 ;; but the DSS identifier is.
126 ;;
127 ;;Output - 1 = Mental health clinic requiring a Gaf
128 ;; 0 = Not a clinic requiring a Gaf
129 N SDNOGAF,SDSTOP,SDCS,SDMH
130 S SDNOGAF="526,527,528,530,533,536,537,542,545,546,565,566,573,574,579"
131 ;; Get either the Clinic IEN or the Clinic Stop code
132 I $G(SDCL) D
133 . S SDSTOP=$P($G(^SC(SDCL,0)),"^",7)
134 E D
135 . S SDSTOP=$G(SDSC)
136 ;
137 S SDCS=$P($G(^DIC(40.7,+SDSTOP,0)),"^",2),SDMH=$S(SDNOGAF[SDCS:0,$E(SDCS)=5:1,1:0)
138 Q SDMH
139 ;
140NEWGAF(DFN) ;;Determine if new GAF Score needed
141 ;;This will be a supported call
142 ;;Determines if a new Gaf is required for a patient and retrieves previous Gaf data
143 ;; If patient is deceased, returns a 0, no new GAF required
144 ;;
145 ;;Input - Patient IEN
146 ;;Output:
147 ;; piece 1 = -1 if New Gaf needed and no previous data
148 ;; = 1 if New Gaf needed and previous data exists
149 ;; = 0 if no New Gaf needed and previous exists
150 ;; piece 2 = previous Gaf score
151 ;; piece 3 = previous Gaf date
152 ;; piece 4 = previous Gaf Providers IEN
153 ;;
154 N SDGAF,SDGAFDT,VADM
155 ;
156 S SDGAF=$$RET^YSGAF(DFN)
157 ;; Check for deceased patient.
158 D DEM^VADPT
159 Q:+$G(VADM(6)) "0^"_SDGAF_"^1"
160 D KVAR^VADPT
161 ;
162 Q:SDGAF=-1 -1
163 S X1=$P(SDGAF,"^",2),X2=90 D C^%DTC
164 Q $S(DT>X:1,1:0)_"^"_SDGAF
165 ;
166GAFCM() ;;
167 N DIR,DIRUT
168 S DIR("A",1)="But a new GAF Score is needed for this patient!"
169 S DIR("A")="Are you sure you want to bypass the check out screen? "
170 S DIR("B")="No",DIR(0)="YA" W ! D ^DIR
171 Q +$G(Y)
172COLLAT(SDEC) ;Determines if patient has a collateral eligibility status
173 ;
174 ; INPUT: SDEC = patient eligibility status
175 ;
176 ; OUTPUT: 1 = collateral patient
177 ; 0 = non-collateral patient
178 ;
179 Q:$G(SDEC)="" 0
180 I $$GET1^DIQ(8,SDEC,8,"I")=13 Q 1
181 Q 0
182 ;
183ELSTAT(DA) ;Retrieve patient eligibility status
184 ;
185 ; INPUT: DA = patient IEN
186 ;
187 ; OUTPUT:
188 ; Function Value - returns the internal entry number for patient's
189 ; eligibility status.
190 ;
191 Q:$G(DA)="" ""
192 Q $$GET1^DIQ(2,DA,.361,"I")
193SCREST(SCIEN,TYP,DIS) ;check stop code restriction in file 40.7 for a clinic.
194 ; INPUT: SCIEN = IEN of Stop Code
195 ; TYP = Stop Code Type, Primary (P) or Secondary (S)
196 ; DIS = Message Display, 1 - Display or 0 No Display
197 ;
198 ; OUTPUT: 1 if no error, or 0^error message
199 ;
200 N SCN,RTY,CTY,RDT,STR,STYP
201 S DIS=$G(DIS,0),STYP="("_$S(TYP="P":"Prim",1:"Second")_"ary)"
202 I +SCIEN<1 S STR="Invalid Clinic Stop Code "_STYP_"." D MSG Q "0^"_STR
203 S CTY=$S(TYP="P":"^P^E^",1:"^S^E^")
204 S SCN=$G(^DIC(40.7,SCIEN,0)),RTY=$P(SCN,U,6),RDT=$P(SCN,U,7)
205 I RTY="" D Q "0^"_STR
206 .S STR="Clinic's Stop Code "_$P(SCN,U,2)_" has no restriction type "_STYP_"." D MSG
207 I CTY'[("^"_RTY_"^") D D MSG Q "0^"_STR
208 .S STR="Clinic's Stop Code "_$P(SCN,U,2)_" cannot be "_$S(TYP="P":"Prim",1:"Second")_"ary."
209 I RDT>DT D D MSG Q "0^"_STR
210 .S STR="Clinic's Stop Code "_$P(SCN,U,2)_" cannot be used. Restriction date is "_$$FMTE^XLFDT(RDT,"1F")_" "_STYP_"."
211 Q 1
212MSG ;display error message to screen
213 I DIS,$E($G(IOST))="C" W !?5,STR
214 Q
215CLNCK(CLN,DSP) ;Check clinic for valid stop code restriction.
216 ; INPUT: CLN = IEN of Clinic
217 ; DSP = Error Message Display, 1 - Display or 0 No Display
218 ;
219 ; OUTPUT: 1 if no error or 0^error message
220 N PSC,SSC,ND0,VAL
221 S DSP=$G(DSP,0)
222 I CLN="" D Q "0^"_"Invalid Clinic."
223 .I DSP,$E($G(IOST))="C" W !?5,"Invalid Clinic."
224 I $G(^SC(CLN,0))="" D Q "0^"_"Clinic not define or has no zero node."
225 .I DSP,$E($G(IOST))="C" W !?5,"Clinic not define or has no zero node."
226 S ND0=^SC(CLN,0),PSC=$P(ND0,U,7),SSC=$P(ND0,U,18),DSP=$G(DSP,0)
227 I $P(ND0,U,3)'="C" Q 1 ;not a Clinic
228 S VAL=$$SCREST(PSC,"P",DSP)
229 Q:'VAL VAL Q:SSC="" 1
230 S VAL=$$SCREST(SSC,"S",DSP)
231 Q VAL
Note: See TracBrowser for help on using the repository browser.