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