source: Scheduling/trunk/m/BSDX09.m@ 908

Last change on this file since 908 was 888, checked in by Sam Habiel, 14 years ago

Updated version numbers
File size: 5.7 KB
Line 
1BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/18/10 2:26pm
2 ;;1.3T1;BSDX;;Jul 18, 2010
3 ;
4 ; Change Log:
5 ; UJO/TH - v 1.3 on 3100714 - Extra Demographics:
6 ; - Email
7 ; - Cell Phone
8 ; - Country
9 ; - + refactoring of routine
10 ;
11 ; UJO/TH - v 1.3 on 3100715 - Change SSN to PID and get PID field instead
12 ;
13GETREGA(BSDXRET,BSDXPAT) ;EP
14 ;
15 ;Returns IEN^STREET^CITY^STATE^ZIP^NAME^DOB^SSN^HRN
16 ; 10 HOMEPHONE^OFCPHONE^MSGPHONE^
17 ; 13 NOK NAME^RELATIONSHIP^PHONE^STREET^CITY^STATE^ZIP
18 ; 20 DATAREVIEWED^
19 ; 21 RegistrationComments
20 ; 22 EMAIL ADDRESS^PHONE NUMBER [CELLULAR]^COUNTRY
21 ;
22 ;For patient with ien BSDXPAT
23 ;K ^BSDXTMP($J)
24 S BSDXERR=""
25 S BSDXRET="^BSDXTMP("_$J_")"
26 ;
27 N OUT S OUT=$NA(^BSDXTMP($J,0))
28 S $P(@OUT,U,1)="T00030IEN"
29 S $P(@OUT,U,2)="T00030STREET"
30 S $P(@OUT,U,3)="T00030CITY"
31 S $P(@OUT,U,4)="T00030STATE"
32 S $P(@OUT,U,5)="T00030ZIP"
33 S $P(@OUT,U,6)="T00030NAME"
34 S $P(@OUT,U,7)="D00030DOB"
35 S $P(@OUT,U,8)="T00030PID"
36 S $P(@OUT,U,9)="T00030HRN"
37 S $P(@OUT,U,10)="T00030HOMEPHONE"
38 S $P(@OUT,U,11)="T00030OFCPHONE"
39 S $P(@OUT,U,12)="T00030MSGPHONE"
40 S $P(@OUT,U,13)="T00030NOK NAME"
41 S $P(@OUT,U,14)="T00030RELATIONSHIP"
42 S $P(@OUT,U,15)="T00030PHONE"
43 S $P(@OUT,U,16)="T00030STREET"
44 S $P(@OUT,U,17)="T00030CITY"
45 S $P(@OUT,U,18)="T00030STATE"
46 S $P(@OUT,U,19)="T00030ZIP"
47 S $P(@OUT,U,20)="D00030DATAREVIEWED"
48 S $P(@OUT,U,21)="T00030RegistrationComments"
49 S $P(@OUT,U,22)="T00050EMAIL ADDRESS"
50 S $P(@OUT,U,23)="T00020PHONE NUMBER [CELLULAR]"
51 S $P(@OUT,U,24)="T00030COUNTRY"
52 S $E(@OUT,$L(@OUT)+1)=$C(30)
53 ;
54 ;
55 N BSDXNOD,BSDXNAM,Y,U
56 S U="^"
57 S BSDXY="ERROR"
58 K NAME
59 I '+BSDXPAT S ^BSDXTMP($J,1)=$C(31) Q
60 I '$D(^DPT(+BSDXPAT,0)) S ^BSDXTMP($J,1)=$C(31) Q
61 S BSDXY=""
62 S $P(BSDXY,U)=BSDXPAT
63 ;//smh S $P(BSDXY,U,23)=""
64 S $P(BSDXY,U,21)=""
65 S BSDXNOD=^DPT(+BSDXPAT,0)
66 S $P(BSDXY,"^",6)=$P(BSDXNOD,U) ;NAME
67 S $P(BSDXY,"^",8)=$$GET1^DIQ(2,BSDXPAT,"PRIMARY LONG ID") ;PID
68 S Y=$P(BSDXNOD,U,3) I Y]"" X ^DD("DD") S Y=$TR(Y,"@"," ")
69 S $P(BSDXY,"^",7)=Y ;DOB
70 S $P(BSDXY,"^",9)=""
71 I $D(DUZ(2)) I DUZ(2)>0 S $P(BSDXY,"^",9)=$P($G(^AUPNPAT(BSDXPAT,41,DUZ(2),0)),U,2) ;HRN
72 D MAIL
73 D PHONE
74 D NOK
75 D DATAREV
76 ;/smh D MEDICARE
77 D REGCMT
78 S $P(BSDXY,"^",22)=$$GET1^DIQ(2,BSDXPAT,"EMAIL ADDRESS")
79 S $P(BSDXY,"^",23)=$$GET1^DIQ(2,BSDXPAT,"PHONE NUMBER [CELLULAR]")
80 S $P(BSDXY,"^",24)=$$GET1^DIQ(2,BSDXPAT,"COUNTRY:DESCRIPTION")
81 N BSDXBEG,BSDXEND,BSDXLEN,BSDXI
82 S BSDXLEN=$L(BSDXY)
83 S BSDXBEG=0,BSDXI=2
84 F D Q:BSDXEND=BSDXLEN
85 . S BSDXEND=BSDXBEG+100
86 . S:BSDXEND>BSDXLEN BSDXEND=BSDXLEN
87 . S BSDXI=BSDXI+1
88 . S ^BSDXTMP($J,BSDXI)=$E(BSDXY,BSDXBEG,BSDXEND)
89 . S BSDXBEG=BSDXBEG+101
90 S ^BSDXTMP($J,BSDXI+1)=$C(30)_$C(31)
91 Q
92 ;
93MAIL N BSDXST
94 Q:'$D(^DPT(+BSDXPAT,.11))
95 S BSDXNOD=^DPT(+BSDXPAT,.11)
96 Q:BSDXNOD=""
97 S $P(BSDXY,"^",2)=$E($P(BSDXNOD,U),1,50) ;STREET
98 S $P(BSDXY,"^",3)=$P(BSDXNOD,U,4) ;CITY
99 S BSDXST=$P(BSDXNOD,U,5)
100 I +BSDXST,$D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2)
101 S $P(BSDXY,"^",4)=BSDXST ;STATE
102 S $P(BSDXY,"^",5)=$P(BSDXNOD,U,6) ;ZIP
103 Q
104 ;
105PHONE ;PHONE 10,11,12 HOME,OFC,MSG
106 I $D(^DPT(+BSDXPAT,.13)) D
107 . S BSDXNOD=^DPT(+BSDXPAT,.13)
108 . S $P(BSDXY,U,10)=$P(BSDXNOD,U,1)
109 . S $P(BSDXY,U,11)=$P(BSDXNOD,U,2)
110 I $D(^DPT(+BSDXPAT,.121)) D
111 . S BSDXNOD=^DPT(+BSDXPAT,.121)
112 . S $P(BSDXY,U,12)=$P(BSDXNOD,U,10)
113 Q
114 ;
115NOK ;NOK
116 ; 13 NOK NAME^RELATIONSHIP^PHONE^STREET^CITY^STATE^ZIP
117 N Y,BSDXST
118 I $D(^DPT(+BSDXPAT,.21)) D
119 . S BSDXNOD=^DPT(+BSDXPAT,.21)
120 . S $P(BSDXY,U,13)=$P(BSDXNOD,U,1)
121 . S $P(BSDXY,U,14)=$$VAL^XBDIQ1(9000001,BSDXPAT,2802)
122 . S $P(BSDXY,U,15)=$P(BSDXNOD,U,9)
123 . S $P(BSDXY,U,16)=$P(BSDXNOD,U,3)
124 . S $P(BSDXY,U,17)=$P(BSDXNOD,U,6)
125 . S BSDXST=$P(BSDXNOD,U,7)
126 . I +BSDXST D
127 . . I $D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2),$P(BSDXY,U,18)=BSDXST
128 . S $P(BSDXY,U,19)=$P(BSDXNOD,U,8)
129 Q
130 ;
131DATAREV S $P(BSDXY,U,20)=$P($$VAL^XBDIQ1(9000001,BSDXPAT,16651),"@")
132 Q
133 ;
134REGCMT N BSDXI,BSDXM,BSDXR
135 S BSDXR=""
136 D ENP^XBDIQ1(9000001,BSDXPAT,1301,"BSDXM(")
137 S BSDXI=0 F S BSDXI=$O(BSDXM(1301,BSDXI)) Q:'+BSDXI D
138 . S BSDXR=BSDXR_" "_BSDXM(1301,BSDXI)
139 ; S $P(BSDXY,U,23)=$TR($E(BSDXR,1,1024),U," ") ; MJL 1/17/2007 //smh
140 S $P(BSDXY,U,21)=$TR($E(BSDXR,1,1024),U," ") ;
141 Q
142 ;
143GETMCAID(BSDXY,BSDXPAT) ; not in wv
144 ;Returns PATIENTIEN^ENTRY#^MEDICAID#^SUBENTRY#^ELIG.BEGIN^ELIG.END |
145 ;File is not dinum
146 N C,N,ASDGX,BSDXM,BSDXBLD,BSDXCNT
147 N BSDXIEN
148 S BSDXBLD=""
149 S BSDXIEN=0
150 S BSDXCNT=1
151 F S BSDXIEN=$O(^AUPNMCD("B",BSDXPAT,BSDXIEN)) Q:'+BSDXIEN D
152 . S BSDXNUM=$$VAL^XBDIQ1(9000004,BSDXIEN,.03) ;MCAID#
153 . D ENPM^XBDIQ1(9000004.11,BSDXIEN_",0",".01:.02","ASDGX(")
154 . S C=1,N=0,BSDXM=""
155 . F S N=$O(ASDGX(N)) Q:'N D
156 . . S $P(BSDXY,"|",C)=BSDXPAT_U_BSDXIEN_U_BSDXNUM_U_N_U_ASDGX(N,.01)_U_ASDGX(N,.02)
157 . . S C=C+1
158 . . Q
159 . Q
160 Q
161 ;
162MEDICARE ; not in WV
163 S $P(BSDXY,U,21)=$$VAL^XBDIQ1(9000003,BSDXPAT,.03)
164 S $P(BSDXY,U,22)=$$VAL^XBDIQ1(9000003,BSDXPAT,.04)
165 Q
166 ;
167GETMCARE(BSDXY,BSDXPAT) ;
168 ;Returns IEN^MEDICARE#^SUFFIX^SUBENTRY#^TYPE^ELIG.BEGIN^ELIG.END |
169 ;File is dinum
170 ;
171 N ASDGX,C,N,BSDXNUM,BSDXSUF,BSDXBLD
172 S BSDXNUM=$$VAL^XBDIQ1(9000003,BSDXPAT,.03)
173 S BSDXSUF=$$VAL^XBDIQ1(9000003,BSDXPAT,.04)
174 D ENPM^XBDIQ1(9000003.11,BSDXPAT_",0",".01:.03","ASDGX(")
175 S C=1,N=0,BSDXBLD=""
176 F S N=$O(ASDGX(N)) Q:'N D
177 . S $P(BSDXY,"|",C)=BSDXPAT_U_BSDXNUM_U_BSDXSUF_U_N_U_ASDGX(N,.03)_U_ASDGX(N,.01)_U_ASDGX(N,.02)
178 . S C=C+1
179 . Q
180 Q
181 ;
182GETPVTIN(BSDXY,BSDXPAT) ;
183 ;Returns IEN^SUBENTRY^INSURER^POLICYNUMBER^ELIG.BEGIN^ELIG.END|...
184 ;File is dinum
185 ;
186 N ASDGX,C,N
187 D ENPM^XBDIQ1(9000006.11,BSDXPAT_",0",".01;.02;.06;.07","ASDGX(")
188 S C=1,N=0
189 F S N=$O(ASDGX(N)) Q:'N D
190 . S $P(BSDXY,"|",C)=BSDXPAT_U_N_U_ASDGX(N,.01)_U_ASDGX(N,.02)_U_ASDGX(N,.06)_U_ASDGX(N,.07)
191 . S C=C+1
192 . Q
193 Q
194 ;
195DFN(FILE,BSDXPAT) ; -- returns ien for file
196 I FILE'[9000004 Q BSDXPAT
197 Q +$O(^AUPNMCD("B",BSDXPAT,0))
Note: See TracBrowser for help on using the repository browser.