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

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

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