BSDX28 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
;
;HMW 20050721 Added test for inactivated record
;
PTLOOKRS(BSDXY,BSDXP,BSDXC) ;EP Patient Lookup
;
;Called by BSDXPatientLookupRS
;Find up to BSDXC patients matching BSDXP*
;Supports DOB Lookup, SSN Lookup
;
;S X="ERROR^BSDX28",@^%ZOSF("TRAP")
S BSDXP=$TR(BSDXP,$C(13),"")
S BSDXP=$TR(BSDXP,$C(10),"")
S BSDXP=$TR(BSDXP,$C(9),"")
S:BSDXC="" BSDXC=10
N BSDXHRN,BSDXZ,BSDXDLIM,BSDXRET,BSDXDPT,BSDXRET,BSDXIEN,BSDXFILE
N BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN
N BSDXTARG,BSDXMSG,BSDXRSLT,BSDXCNT
S BSDXDLIM="^"
S BSDXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)
I '+$G(DUZ) S BSDXY=BSDXRET_$C(31) Q
I '$D(DUZ(2)) S BSDXY=BSDXRET_$C(31) Q
;
DOB ;DOB Lookup
I +DUZ(2),((BSDXP?1.2N1"/"1.2N1"/"1.4N)!(BSDXP?1.2N1" "1.2N1" "1.4N)!(BSDXP?1.2N1"-"1.2N1"-"1.4N)!(BSDXP?1.2N1"."1.2N1"."1.4N)) D S BSDXY=BSDXRET_$C(31) Q
. S X=BSDXP S %DT="P" D ^%DT S BSDXP=Y Q:'+Y
. Q:'$D(^DPT("ADOB",BSDXP))
. S BSDXIEN=0 F S BSDXIEN=$O(^DPT("ADOB",BSDXP,BSDXIEN)) Q:'+BSDXIEN D
. . Q:'$D(^DPT(BSDXIEN,0))
. . S BSDXDPT=$G(^DPT(BSDXIEN,0))
. . S BSDXZ=$P(BSDXDPT,U) ;NAME
. . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
. . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
. . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
. . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
. . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
. . S BSDXRET=BSDXRET_BSDXZ_$C(30)
. . Q
. Q
;
;Chart# Lookup
I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q
. S BSDXIEN=0 F S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D Q
. . Q:'$D(^DPT(BSDXIEN,0))
. . S BSDXDPT=$G(^DPT(BSDXIEN,0))
. . S BSDXZ=$P(BSDXDPT,U) ;NAME
. . S BSDXHRN=BSDXP ;CHART
. . I $D(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
. . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
. . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
. . S BSDXRET=BSDXRET_BSDXZ_$C(30)
. . Q
. Q
;
;SSN Lookup
I (BSDXP?9N)!(BSDXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q
. S BSDXIEN=0 F S BSDXIEN=$O(^DPT("SSN",BSDXP,BSDXIEN)) Q:'+BSDXIEN D Q
. . Q:'$D(^DPT(BSDXIEN,0))
. . S BSDXDPT=$G(^DPT(BSDXIEN,0))
. . S BSDXZ=$P(BSDXDPT,U) ;NAME
. . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
. . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
. . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
. . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
. . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
. . S BSDXRET=BSDXRET_BSDXZ_$C(30)
. . Q
. Q
;
;All Patients
I BSDXP="" D S BSDXY=BSDXRET_$C(31) Q
. D LISTALL^BEHOPTPL(.PLIST,"",1)
. S BSDXCNT=0 F S BSDXCNT=$O(PLIST(BSDXCNT)) Q:'BSDXCNT D
. . S BSDXIEN=$P(PLIST(BSDXCNT),U)
. . S BSDXDPT=$G(^DPT(BSDXIEN,0))
. . S BSDXZ=$P(BSDXDPT,U)
. . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
. . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
. . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
. . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
. . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
. . S BSDXRET=BSDXRET_BSDXZ_$C(30)
. . Q
. Q
;
S BSDXFILE=9000001
S BSDXIENS=""
S BSDXFIELDS=".01"
S BSDXFLAGS="M"
S BSDXVALUE=BSDXP
S BSDXNUMBER=BSDXC
S BSDXINDEXES=""
S BSDXSCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
S BSDXIDEN=""
S BSDXTARG="BSDXRSLT"
S BSDXMSG=""
D FIND^DIC(BSDXFILE,BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN,BSDXIDEN,BSDXTARG,BSDXMSG)
I '+$G(BSDXRSLT("DILIST",0)) S BSDXY=BSDXRET_$C(31) Q
N BSDXCNT S BSDXCNT=2
F BSDXX=1:1:$P(BSDXRSLT("DILIST",0),U) D
. S BSDXIEN=BSDXRSLT("DILIST",2,BSDXX)
. S BSDXZ=BSDXRSLT("DILIST","ID",BSDXX,.01) ;NAME
. S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
. I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
. I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
. S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. S BSDXDPT=$G(^DPT(BSDXIEN,0))
. S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
. S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
. S $P(BSDXRET,$C(30),BSDXCNT)=BSDXZ
. S BSDXCNT=BSDXCNT+1
. Q
S BSDXY=BSDXRET_$C(30)_$C(31)
Q
;
ERROR ;
D ERR("RPMS Error")
Q
;
ERR(ERRNO) ;Error processing
S BSDXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)_"^^^^"_$C(30)_$C(31)
Q
BSDX28 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+2 ;
+3 ;HMW 20050721 Added test for inactivated record
+4 ;
PTLOOKRS(BSDXY,BSDXP,BSDXC) ;EP Patient Lookup
+1 ;
+2 ;Called by BSDXPatientLookupRS
+3 ;Find up to BSDXC patients matching BSDXP*
+4 ;Supports DOB Lookup, SSN Lookup
+5 ;
+6 ;S X="ERROR^BSDX28",@^%ZOSF("TRAP")
+7 SET BSDXP=$TRANSLATE(BSDXP,$CHAR(13),"")
+8 SET BSDXP=$TRANSLATE(BSDXP,$CHAR(10),"")
+9 SET BSDXP=$TRANSLATE(BSDXP,$CHAR(9),"")
+10 IF BSDXC=""
SET BSDXC=10
+11 NEW BSDXHRN,BSDXZ,BSDXDLIM,BSDXRET,BSDXDPT,BSDXRET,BSDXIEN,BSDXFILE
+12 NEW BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN
+13 NEW BSDXTARG,BSDXMSG,BSDXRSLT,BSDXCNT
+14 SET BSDXDLIM="^"
+15 SET BSDXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$CHAR(30)
+16 IF '+$GET(DUZ)
SET BSDXY=BSDXRET_$CHAR(31)
QUIT
+17 IF '$DATA(DUZ(2))
SET BSDXY=BSDXRET_$CHAR(31)
QUIT
+18 ;
DOB ;DOB Lookup
+1 IF +DUZ(2)
IF ((BSDXP?1.2N1"/"1.2N1"/"1.4N)!(BSDXP?1.2N1" "1.2N1" "1.4N)!(BSDXP?1.2N1"-"1.2N1"-"1.4N)!(BSDXP?1.2N1"."1.2N1"."1.4N))
Begin DoDot:1
+2 SET X=BSDXP
SET %DT="P"
DO ^%DT
SET BSDXP=Y
IF '+Y
QUIT
+3 IF '$DATA(^DPT("ADOB",BSDXP))
QUIT
+4 SET BSDXIEN=0
FOR
SET BSDXIEN=$ORDER(^DPT("ADOB",BSDXP,BSDXIEN))
IF '+BSDXIEN
QUIT
Begin DoDot:2
+5 IF '$DATA(^DPT(BSDXIEN,0))
QUIT
+6 SET BSDXDPT=$GET(^DPT(BSDXIEN,0))
+7 ;NAME
SET BSDXZ=$PIECE(BSDXDPT,U)
+8 ;CHART
SET BSDXHRN=$PIECE($GET(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2)
+9 ;NO CHART AT THIS DUZ2
IF BSDXHRN=""
QUIT
+10 ;HMW 20050721 Record Inactivated
IF $PIECE($GET(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3)
SET BSDXHRN=BSDXHRN_"(*)"
QUIT
+11 SET $PIECE(BSDXZ,BSDXDLIM,2)=BSDXHRN
+12 ;SSN
SET $PIECE(BSDXZ,BSDXDLIM,3)=$PIECE(BSDXDPT,U,9)
+13 SET Y=$PIECE(BSDXDPT,U,3)
XECUTE ^DD("DD")
+14 ;DOB
SET $PIECE(BSDXZ,BSDXDLIM,4)=Y
+15 SET $PIECE(BSDXZ,BSDXDLIM,5)=BSDXIEN
+16 SET BSDXRET=BSDXRET_BSDXZ_$CHAR(30)
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
SET BSDXY=BSDXRET_$CHAR(31)
QUIT
+19 ;
+20 ;Chart# Lookup
+21 IF +DUZ(2)
IF BSDXP]""
IF $DATA(^AUPNPAT("D",BSDXP))
Begin DoDot:1
+22 SET BSDXIEN=0
FOR
SET BSDXIEN=$ORDER(^AUPNPAT("D",BSDXP,BSDXIEN))
IF '+BSDXIEN
QUIT
IF $DATA(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2)))
Begin DoDot:2
+23 IF '$DATA(^DPT(BSDXIEN,0))
QUIT
+24 SET BSDXDPT=$GET(^DPT(BSDXIEN,0))
+25 ;NAME
SET BSDXZ=$PIECE(BSDXDPT,U)
+26 ;CHART
SET BSDXHRN=BSDXP
+27 ;HMW 20050721 Record Inactivated
IF $DATA(^AUPNPAT(BSDXIEN,41,DUZ(2),0))
IF $PIECE(^(0),U,3)
SET BSDXHRN=BSDXHRN_"(*)"
QUIT
+28 SET $PIECE(BSDXZ,BSDXDLIM,2)=BSDXHRN
+29 ;SSN
SET $PIECE(BSDXZ,BSDXDLIM,3)=$PIECE(BSDXDPT,U,9)
+30 SET Y=$PIECE(BSDXDPT,U,3)
XECUTE ^DD("DD")
+31 ;DOB
SET $PIECE(BSDXZ,BSDXDLIM,4)=Y
+32 SET $PIECE(BSDXZ,BSDXDLIM,5)=BSDXIEN
+33 SET BSDXRET=BSDXRET_BSDXZ_$CHAR(30)
+34 QUIT
End DoDot:2
QUIT
+35 QUIT
End DoDot:1
SET BSDXY=BSDXRET_$CHAR(31)
QUIT
+36 ;
+37 ;SSN Lookup
+38 IF (BSDXP?9N)!(BSDXP?3N1"-"2N1"-"4N)
IF $DATA(^DPT("SSN",BSDXP))
Begin DoDot:1
+39 SET BSDXIEN=0
FOR
SET BSDXIEN=$ORDER(^DPT("SSN",BSDXP,BSDXIEN))
IF '+BSDXIEN
QUIT
Begin DoDot:2
+40 IF '$DATA(^DPT(BSDXIEN,0))
QUIT
+41 SET BSDXDPT=$GET(^DPT(BSDXIEN,0))
+42 ;NAME
SET BSDXZ=$PIECE(BSDXDPT,U)
+43 ;CHART
SET BSDXHRN=$PIECE($GET(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2)
+44 ;NO CHART AT THIS DUZ2
IF BSDXHRN=""
QUIT
+45 ;HMW 20050721 Record Inactivated
IF $PIECE($GET(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3)
SET BSDXHRN=BSDXHRN_"(*)"
QUIT
+46 SET $PIECE(BSDXZ,BSDXDLIM,2)=BSDXHRN
+47 ;SSN
SET $PIECE(BSDXZ,BSDXDLIM,3)=$PIECE(BSDXDPT,U,9)
+48 SET Y=$PIECE(BSDXDPT,U,3)
XECUTE ^DD("DD")
+49 ;DOB
SET $PIECE(BSDXZ,BSDXDLIM,4)=Y
+50 SET $PIECE(BSDXZ,BSDXDLIM,5)=BSDXIEN
+51 SET BSDXRET=BSDXRET_BSDXZ_$CHAR(30)
+52 QUIT
End DoDot:2
QUIT
+53 QUIT
End DoDot:1
SET BSDXY=BSDXRET_$CHAR(31)
QUIT
+54 ;
+55 ;All Patients
+56 IF BSDXP=""
Begin DoDot:1
+57 DO LISTALL^BEHOPTPL(.PLIST,"",1)
+58 SET BSDXCNT=0
FOR
SET BSDXCNT=$ORDER(PLIST(BSDXCNT))
IF 'BSDXCNT
QUIT
Begin DoDot:2
+59 SET BSDXIEN=$PIECE(PLIST(BSDXCNT),U)
+60 SET BSDXDPT=$GET(^DPT(BSDXIEN,0))
+61 SET BSDXZ=$PIECE(BSDXDPT,U)
+62 ;CHART
SET BSDXHRN=$PIECE($GET(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2)
+63 ;NO CHART AT THIS DUZ2
IF BSDXHRN=""
QUIT
+64 ;HMW 20050721 Record Inactivated
IF $PIECE($GET(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3)
SET BSDXHRN=BSDXHRN_"(*)"
QUIT
+65 SET $PIECE(BSDXZ,BSDXDLIM,2)=BSDXHRN
+66 ;SSN
SET $PIECE(BSDXZ,BSDXDLIM,3)=$PIECE(BSDXDPT,U,9)
+67 SET Y=$PIECE(BSDXDPT,U,3)
XECUTE ^DD("DD")
+68 ;DOB
SET $PIECE(BSDXZ,BSDXDLIM,4)=Y
+69 SET $PIECE(BSDXZ,BSDXDLIM,5)=BSDXIEN
+70 SET BSDXRET=BSDXRET_BSDXZ_$CHAR(30)
+71 QUIT
End DoDot:2
+72 QUIT
End DoDot:1
SET BSDXY=BSDXRET_$CHAR(31)
QUIT
+73 ;
+74 SET BSDXFILE=9000001
+75 SET BSDXIENS=""
+76 SET BSDXFIELDS=".01"
+77 SET BSDXFLAGS="M"
+78 SET BSDXVALUE=BSDXP
+79 SET BSDXNUMBER=BSDXC
+80 SET BSDXINDEXES=""
+81 SET BSDXSCREEN=$SELECT(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
+82 SET BSDXIDEN=""
+83 SET BSDXTARG="BSDXRSLT"
+84 SET BSDXMSG=""
+85 DO FIND^DIC(BSDXFILE,BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN,BSDXIDEN,BSDXTARG,BSDXMSG)
+86 IF '+$GET(BSDXRSLT("DILIST",0))
SET BSDXY=BSDXRET_$CHAR(31)
QUIT
+87 NEW BSDXCNT
SET BSDXCNT=2
+88 FOR BSDXX=1:1:$PIECE(BSDXRSLT("DILIST",0),U)
Begin DoDot:1
+89 SET BSDXIEN=BSDXRSLT("DILIST",2,BSDXX)
+90 ;NAME
SET BSDXZ=BSDXRSLT("DILIST","ID",BSDXX,.01)
+91 ;CHART
SET BSDXHRN=$PIECE($GET(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2)
+92 ;NO CHART AT THIS DUZ2
IF BSDXHRN=""
QUIT
+93 ;HMW 20050721 Record Inactivated
IF $PIECE($GET(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3)
SET BSDXHRN=BSDXHRN_"(*)"
QUIT
+94 SET $PIECE(BSDXZ,BSDXDLIM,2)=BSDXHRN
+95 SET BSDXDPT=$GET(^DPT(BSDXIEN,0))
+96 ;SSN
SET $PIECE(BSDXZ,BSDXDLIM,3)=$PIECE(BSDXDPT,U,9)
+97 SET Y=$PIECE(BSDXDPT,U,3)
XECUTE ^DD("DD")
+98 ;DOB
SET $PIECE(BSDXZ,BSDXDLIM,4)=Y
+99 SET $PIECE(BSDXZ,BSDXDLIM,5)=BSDXIEN
+100 SET $PIECE(BSDXRET,$CHAR(30),BSDXCNT)=BSDXZ
+101 SET BSDXCNT=BSDXCNT+1
+102 QUIT
End DoDot:1
+103 SET BSDXY=BSDXRET_$CHAR(30)_$CHAR(31)
+104 QUIT
+105 ;
ERROR ;
+1 DO ERR("RPMS Error")
+2 QUIT
+3 ;
ERR(ERRNO) ;Error processing
+1 SET BSDXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$CHAR(30)_"^^^^"_$CHAR(30)_$CHAR(31)
+2 QUIT
