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

Last change on this file since 838 was 614, checked in by Sam Habiel, 15 years ago

Initial committ of scheduling package
File size: 5.0 KB
RevLine 
[614]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 S ^BSDXTMP($J,0)="T00030IEN^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030NAME^D00030DOB^T00030SSN^T00030HRN"
21 S ^BSDXTMP($J,0)=^BSDXTMP($J,0)_"^T00030HOMEPHONE^T00030OFCPHONE^T00030MSGPHONE"
22 S ^BSDXTMP($J,0)=^BSDXTMP($J,0)_"^T00030NOK NAME^T00030RELATIONSHIP^T00030PHONE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP"
23 S ^BSDXTMP($J,0)=^BSDXTMP($J,0)_"^D00030DATAREVIEWED"
24 ; S ^BSDXTMP($J,0)=^BSDXTMP($J,0)_"^T00030Medicare#^T00030Suffix"
25 S ^BSDXTMP($J,0)=^BSDXTMP($J,0)_"^T00030RegistrationComments"
26 S ^BSDXTMP($J,0)=^BSDXTMP($J,0)_$C(30)
27 ;
28 N BSDXNOD,BSDXNAM,Y,U
29 S U="^"
30 S BSDXY="ERROR"
31 I '+BSDXPAT S ^BSDXTMP($J,1)=$C(31) Q
32 I '$D(^DPT(+BSDXPAT,0)) S ^BSDXTMP($J,1)=$C(31) Q
33 S BSDXY=""
34 S $P(BSDXY,U)=BSDXPAT
35 ;//smh S $P(BSDXY,U,23)=""
36 S $P(BSDXY,U,21)=""
37 S BSDXNOD=^DPT(+BSDXPAT,0)
38 S $P(BSDXY,"^",6)=$P(BSDXNOD,U) ;NAME
39 S $P(BSDXY,"^",8)=$P(BSDXNOD,U,9) ;SSN
40 S Y=$P(BSDXNOD,U,3) I Y]"" X ^DD("DD") S Y=$TR(Y,"@"," ")
41 S $P(BSDXY,"^",7)=Y ;DOB
42 S $P(BSDXY,"^",9)=""
43 I $D(DUZ(2)) I DUZ(2)>0 S $P(BSDXY,"^",9)=$P($G(^AUPNPAT(BSDXPAT,41,DUZ(2),0)),U,2) ;HRN
44 D MAIL
45 D PHONE
46 D NOK
47 D DATAREV
48 ;/smh D MEDICARE
49 D REGCMT
50 N BSDXBEG,BSDXEND,BSDXLEN,BSDXI
51 S BSDXLEN=$L(BSDXY)
52 S BSDXBEG=0,BSDXI=2
53 F D Q:BSDXEND=BSDXLEN
54 . S BSDXEND=BSDXBEG+100
55 . S:BSDXEND>BSDXLEN BSDXEND=BSDXLEN
56 . S BSDXI=BSDXI+1
57 . S ^BSDXTMP($J,BSDXI)=$E(BSDXY,BSDXBEG,BSDXEND)
58 . S BSDXBEG=BSDXBEG+101
59 S ^BSDXTMP($J,BSDXI+1)=$C(30)_$C(31)
60 Q
61 ;
62MAIL N BSDXST
63 Q:'$D(^DPT(+BSDXPAT,.11))
64 S BSDXNOD=^DPT(+BSDXPAT,.11)
65 Q:BSDXNOD=""
66 S $P(BSDXY,"^",2)=$E($P(BSDXNOD,U),1,50) ;STREET
67 S $P(BSDXY,"^",3)=$P(BSDXNOD,U,4) ;CITY
68 S BSDXST=$P(BSDXNOD,U,5)
69 I +BSDXST,$D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2)
70 S $P(BSDXY,"^",4)=BSDXST ;STATE
71 S $P(BSDXY,"^",5)=$P(BSDXNOD,U,6) ;ZIP
72 Q
73 ;
74PHONE ;PHONE 10,11,12 HOME,OFC,MSG
75 I $D(^DPT(+BSDXPAT,.13)) D
76 . S BSDXNOD=^DPT(+BSDXPAT,.13)
77 . S $P(BSDXY,U,10)=$P(BSDXNOD,U,1)
78 . S $P(BSDXY,U,11)=$P(BSDXNOD,U,2)
79 I $D(^DPT(+BSDXPAT,.121)) D
80 . S BSDXNOD=^DPT(+BSDXPAT,.121)
81 . S $P(BSDXY,U,12)=$P(BSDXNOD,U,10)
82 Q
83 ;
84NOK ;NOK
85 ; 13 NOK NAME^RELATIONSHIP^PHONE^STREET^CITY^STATE^ZIP
86 N Y,BSDXST
87 I $D(^DPT(+BSDXPAT,.21)) D
88 . S BSDXNOD=^DPT(+BSDXPAT,.21)
89 . S $P(BSDXY,U,13)=$P(BSDXNOD,U,1)
90 . S $P(BSDXY,U,14)=$$VAL^XBDIQ1(9000001,BSDXPAT,2802)
91 . S $P(BSDXY,U,15)=$P(BSDXNOD,U,9)
92 . S $P(BSDXY,U,16)=$P(BSDXNOD,U,3)
93 . S $P(BSDXY,U,17)=$P(BSDXNOD,U,6)
94 . S BSDXST=$P(BSDXNOD,U,7)
95 . I +BSDXST D
96 . . I $D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2),$P(BSDXY,U,18)=BSDXST
97 . S $P(BSDXY,U,19)=$P(BSDXNOD,U,8)
98 Q
99 ;
100DATAREV S $P(BSDXY,U,20)=$P($$VAL^XBDIQ1(9000001,BSDXPAT,16651),"@")
101 Q
102 ;
103REGCMT N BSDXI,BSDXM,BSDXR
104 S BSDXR=""
105 D ENP^XBDIQ1(9000001,BSDXPAT,1301,"BSDXM(")
106 S BSDXI=0 F S BSDXI=$O(BSDXM(1301,BSDXI)) Q:'+BSDXI D
107 . S BSDXR=BSDXR_" "_BSDXM(1301,BSDXI)
108 ; S $P(BSDXY,U,23)=$TR($E(BSDXR,1,1024),U," ") ; MJL 1/17/2007 //smh
109 S $P(BSDXY,U,21)=$TR($E(BSDXR,1,1024),U," ") ;
110 Q
111 ;
112GETMCAID(BSDXY,BSDXPAT) ; not in wv
113 ;Returns PATIENTIEN^ENTRY#^MEDICAID#^SUBENTRY#^ELIG.BEGIN^ELIG.END |
114 ;File is not dinum
115 N C,N,ASDGX,BSDXM,BSDXBLD,BSDXCNT
116 N BSDXIEN
117 S BSDXBLD=""
118 S BSDXIEN=0
119 S BSDXCNT=1
120 F S BSDXIEN=$O(^AUPNMCD("B",BSDXPAT,BSDXIEN)) Q:'+BSDXIEN D
121 . S BSDXNUM=$$VAL^XBDIQ1(9000004,BSDXIEN,.03) ;MCAID#
122 . D ENPM^XBDIQ1(9000004.11,BSDXIEN_",0",".01:.02","ASDGX(")
123 . S C=1,N=0,BSDXM=""
124 . F S N=$O(ASDGX(N)) Q:'N D
125 . . S $P(BSDXY,"|",C)=BSDXPAT_U_BSDXIEN_U_BSDXNUM_U_N_U_ASDGX(N,.01)_U_ASDGX(N,.02)
126 . . S C=C+1
127 . . Q
128 . Q
129 Q
130 ;
131MEDICARE ; not in WV
132 S $P(BSDXY,U,21)=$$VAL^XBDIQ1(9000003,BSDXPAT,.03)
133 S $P(BSDXY,U,22)=$$VAL^XBDIQ1(9000003,BSDXPAT,.04)
134 Q
135 ;
136GETMCARE(BSDXY,BSDXPAT) ;
137 ;Returns IEN^MEDICARE#^SUFFIX^SUBENTRY#^TYPE^ELIG.BEGIN^ELIG.END |
138 ;File is dinum
139 ;
140 N ASDGX,C,N,BSDXNUM,BSDXSUF,BSDXBLD
141 S BSDXNUM=$$VAL^XBDIQ1(9000003,BSDXPAT,.03)
142 S BSDXSUF=$$VAL^XBDIQ1(9000003,BSDXPAT,.04)
143 D ENPM^XBDIQ1(9000003.11,BSDXPAT_",0",".01:.03","ASDGX(")
144 S C=1,N=0,BSDXBLD=""
145 F S N=$O(ASDGX(N)) Q:'N D
146 . S $P(BSDXY,"|",C)=BSDXPAT_U_BSDXNUM_U_BSDXSUF_U_N_U_ASDGX(N,.03)_U_ASDGX(N,.01)_U_ASDGX(N,.02)
147 . S C=C+1
148 . Q
149 Q
150 ;
151GETPVTIN(BSDXY,BSDXPAT) ;
152 ;Returns IEN^SUBENTRY^INSURER^POLICYNUMBER^ELIG.BEGIN^ELIG.END|...
153 ;File is dinum
154 ;
155 N ASDGX,C,N
156 D ENPM^XBDIQ1(9000006.11,BSDXPAT_",0",".01;.02;.06;.07","ASDGX(")
157 S C=1,N=0
158 F S N=$O(ASDGX(N)) Q:'N D
159 . S $P(BSDXY,"|",C)=BSDXPAT_U_N_U_ASDGX(N,.01)_U_ASDGX(N,.02)_U_ASDGX(N,.06)_U_ASDGX(N,.07)
160 . S C=C+1
161 . Q
162 Q
163 ;
164DFN(FILE,BSDXPAT) ; -- returns ien for file
165 I FILE'[9000004 Q BSDXPAT
166 Q +$O(^AUPNMCD("B",BSDXPAT,0))
Note: See TracBrowser for help on using the repository browser.