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