Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BSDX09

BSDX09.m

Go to the documentation of this file. 
  1. BSDX09 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ; 
  1.  ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
  1.  ;
  1.  ;
  1. GETREGA(BSDXRET,BSDXPAT)        ;EP
  1.  ;
  1.  ;Returns IEN^STREET^CITY^STATE^ZIP^NAME^DOB^SSN^HRN
  1.  ;   10 HOMEPHONE^OFCPHONE^MSGPHONE^
  1.  ;   13 NOK NAME^RELATIONSHIP^PHONE^STREET^CITY^STATE^ZIP
  1.  ;   20 DATAREVIEWED^
  1.  ;   21 Medicare#^Suffix
  1.  ;   23 RegistrationComments
  1.  ;
  1.  ;For patient with ien BSDXPAT
  1.  ;K ^BSDXTMP($J)
  1.  S BSDXERR=""
  1.  S BSDXRET="^BSDXTMP("_$J_")"
  1.  ;
  1.  S ^BSDXTMP($J,0)="T00030IEN^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030NAME^D00030DOB^T00030SSN^T00030HRN"
  1.  S ^BSDXTMP($J,0)=^BSDXTMP($J,0)_"^T00030HOMEPHONE^T00030OFCPHONE^T00030MSGPHONE"
  1.  S ^BSDXTMP($J,0)=^BSDXTMP($J,0)_"^T00030NOK NAME^T00030RELATIONSHIP^T00030PHONE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP"
  1.  S ^BSDXTMP($J,0)=^BSDXTMP($J,0)_"^D00030DATAREVIEWED"
  1.  S ^BSDXTMP($J,0)=^BSDXTMP($J,0)_"^T00030Medicare#^T00030Suffix"
  1.  S ^BSDXTMP($J,0)=^BSDXTMP($J,0)_"^T00030RegistrationComments"
  1.  S ^BSDXTMP($J,0)=^BSDXTMP($J,0)_$C(30)
  1.  ;
  1.  N BSDXNOD,BSDXNAM,Y,U
  1.  S U="^"
  1.  S BSDXY="ERROR"
  1.  I '+BSDXPAT S ^BSDXTMP($J,1)=$C(31) Q
  1.  I '$D(^DPT(+BSDXPAT,0)) S ^BSDXTMP($J,1)=$C(31) Q
  1.  S BSDXY=""
  1.  S $P(BSDXY,U)=BSDXPAT
  1.  S $P(BSDXY,U,23)=""
  1.  S BSDXNOD=^DPT(+BSDXPAT,0)
  1.  S $P(BSDXY,"^",6)=$P(BSDXNOD,U) ;NAME
  1.  S $P(BSDXY,"^",8)=$P(BSDXNOD,U,9) ;SSN
  1.  S Y=$P(BSDXNOD,U,3) I Y]""  X ^DD("DD") S Y=$TR(Y,"@"," ")
  1.  S $P(BSDXY,"^",7)=Y ;DOB
  1.  S $P(BSDXY,"^",9)=""
  1.  I $D(DUZ(2)) I DUZ(2)>0 S $P(BSDXY,"^",9)=$P($G(^AUPNPAT(BSDXPAT,41,DUZ(2),0)),U,2) ;HRN
  1.  D MAIL
  1.  D PHONE
  1.  D NOK
  1.  D DATAREV
  1.  D MEDICARE
  1.  D REGCMT
  1.  N BSDXBEG,BSDXEND,BSDXLEN,BSDXI
  1.  S BSDXLEN=$L(BSDXY)
  1.  S BSDXBEG=0,BSDXI=2
  1.  F  D  Q:BSDXEND=BSDXLEN
  1.  . S BSDXEND=BSDXBEG+100
  1.  . S:BSDXEND>BSDXLEN BSDXEND=BSDXLEN
  1.  . S BSDXI=BSDXI+1
  1.  . S ^BSDXTMP($J,BSDXI)=$E(BSDXY,BSDXBEG,BSDXEND)
  1.  . S BSDXBEG=BSDXBEG+101
  1.  S ^BSDXTMP($J,BSDXI+1)=$C(30)_$C(31)
  1.  Q
  1.  ;
  1. MAIL N BSDXST
  1.  Q:'$D(^DPT(+BSDXPAT,.11))
  1.  S BSDXNOD=^DPT(+BSDXPAT,.11)
  1.  Q:BSDXNOD=""
  1.  S $P(BSDXY,"^",2)=$E($P(BSDXNOD,U),1,50) ;STREET
  1.  S $P(BSDXY,"^",3)=$P(BSDXNOD,U,4) ;CITY
  1.  S BSDXST=$P(BSDXNOD,U,5)
  1.  I +BSDXST,$D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2)
  1.  S $P(BSDXY,"^",4)=BSDXST ;STATE
  1.  S $P(BSDXY,"^",5)=$P(BSDXNOD,U,6) ;ZIP
  1.  Q
  1.  ;
  1. PHONE ;PHONE 10,11,12 HOME,OFC,MSG
  1.  I $D(^DPT(+BSDXPAT,.13)) D
  1.  . S BSDXNOD=^DPT(+BSDXPAT,.13)
  1.  . S $P(BSDXY,U,10)=$P(BSDXNOD,U,1)
  1.  . S $P(BSDXY,U,11)=$P(BSDXNOD,U,2)
  1.  I $D(^DPT(+BSDXPAT,.121)) D
  1.  . S BSDXNOD=^DPT(+BSDXPAT,.121)
  1.  . S $P(BSDXY,U,12)=$P(BSDXNOD,U,10)
  1.  Q
  1.  ;
  1. NOK ;NOK
  1.  ;   13 NOK NAME^RELATIONSHIP^PHONE^STREET^CITY^STATE^ZIP
  1.  N Y,BSDXST
  1.  I $D(^DPT(+BSDXPAT,.21)) D
  1.  . S BSDXNOD=^DPT(+BSDXPAT,.21)
  1.  . S $P(BSDXY,U,13)=$P(BSDXNOD,U,1)
  1.  . S $P(BSDXY,U,14)=$$VAL^XBDIQ1(9000001,BSDXPAT,2802)
  1.  . S $P(BSDXY,U,15)=$P(BSDXNOD,U,9)
  1.  . S $P(BSDXY,U,16)=$P(BSDXNOD,U,3)
  1.  . S $P(BSDXY,U,17)=$P(BSDXNOD,U,6)
  1.  . S BSDXST=$P(BSDXNOD,U,7)
  1.  . I +BSDXST D
  1.  . . I $D(^DIC(5,+BSDXST,0)) S BSDXST=$P(^DIC(5,+BSDXST,0),U,2),$P(BSDXY,U,18)=BSDXST
  1.  . S $P(BSDXY,U,19)=$P(BSDXNOD,U,8)
  1.  Q
  1.  ;
  1. DATAREV S $P(BSDXY,U,20)=$P($$VAL^XBDIQ1(9000001,BSDXPAT,16651),"@")
  1.  Q
  1.  ;
  1. REGCMT N BSDXI,BSDXM,BSDXR
  1.  S BSDXR=""
  1.  D ENP^XBDIQ1(9000001,BSDXPAT,1301,"BSDXM(")
  1.  S BSDXI=0 F  S BSDXI=$O(BSDXM(1301,BSDXI)) Q:'+BSDXI  D
  1.  . S BSDXR=BSDXR_" "_BSDXM(1301,BSDXI)
  1.  S $P(BSDXY,U,23)=$TR($E(BSDXR,1,1024),U," ") ; MJL 1/17/2007
  1.  Q
  1.  ;
  1. GETMCAID(BSDXY,BSDXPAT) ;
  1.  ;Returns PATIENTIEN^ENTRY#^MEDICAID#^SUBENTRY#^ELIG.BEGIN^ELIG.END |
  1.  ;File is not dinum
  1.  N C,N,ASDGX,BSDXM,BSDXBLD,BSDXCNT
  1.  N BSDXIEN
  1.  S BSDXBLD=""
  1.  S BSDXIEN=0
  1.  S BSDXCNT=1
  1.  F  S BSDXIEN=$O(^AUPNMCD("B",BSDXPAT,BSDXIEN)) Q:'+BSDXIEN  D
  1.  . S BSDXNUM=$$VAL^XBDIQ1(9000004,BSDXIEN,.03) ;MCAID#
  1.  . D ENPM^XBDIQ1(9000004.11,BSDXIEN_",0",".01:.02","ASDGX(")
  1.  . S C=1,N=0,BSDXM=""
  1.  . F  S N=$O(ASDGX(N)) Q:'N  D
  1.  . . S $P(BSDXY,"|",C)=BSDXPAT_U_BSDXIEN_U_BSDXNUM_U_N_U_ASDGX(N,.01)_U_ASDGX(N,.02)
  1.  . . S C=C+1
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. MEDICARE ;
  1.  S $P(BSDXY,U,21)=$$VAL^XBDIQ1(9000003,BSDXPAT,.03)
  1.  S $P(BSDXY,U,22)=$$VAL^XBDIQ1(9000003,BSDXPAT,.04)
  1.  Q
  1.  ;
  1. GETMCARE(BSDXY,BSDXPAT)      ;
  1.  ;Returns IEN^MEDICARE#^SUFFIX^SUBENTRY#^TYPE^ELIG.BEGIN^ELIG.END |
  1.  ;File is dinum
  1.  ;
  1.  N ASDGX,C,N,BSDXNUM,BSDXSUF,BSDXBLD
  1.  S BSDXNUM=$$VAL^XBDIQ1(9000003,BSDXPAT,.03)
  1.  S BSDXSUF=$$VAL^XBDIQ1(9000003,BSDXPAT,.04)
  1.  D ENPM^XBDIQ1(9000003.11,BSDXPAT_",0",".01:.03","ASDGX(")
  1.  S C=1,N=0,BSDXBLD=""
  1.  F  S N=$O(ASDGX(N)) Q:'N  D
  1.  . S $P(BSDXY,"|",C)=BSDXPAT_U_BSDXNUM_U_BSDXSUF_U_N_U_ASDGX(N,.03)_U_ASDGX(N,.01)_U_ASDGX(N,.02)
  1.  . S C=C+1
  1.  . Q
  1.  Q
  1.  ;
  1. GETPVTIN(BSDXY,BSDXPAT) ;
  1.  ;Returns IEN^SUBENTRY^INSURER^POLICYNUMBER^ELIG.BEGIN^ELIG.END|...
  1.  ;File is dinum
  1.  ;
  1.  N ASDGX,C,N
  1.  D ENPM^XBDIQ1(9000006.11,BSDXPAT_",0",".01;.02;.06;.07","ASDGX(")
  1.  S C=1,N=0
  1.  F  S N=$O(ASDGX(N)) Q:'N  D
  1.  . S $P(BSDXY,"|",C)=BSDXPAT_U_N_U_ASDGX(N,.01)_U_ASDGX(N,.02)_U_ASDGX(N,.06)_U_ASDGX(N,.07)
  1.  . S C=C+1
  1.  . Q
  1.  Q
  1.  ;
  1. DFN(FILE,BSDXPAT) ; -- returns ien for file
  1.  I FILE'[9000004 Q BSDXPAT
  1.  Q +$O(^AUPNMCD("B",BSDXPAT,0))