BMXRPC4 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;4.0;BMX;;JUN 28, 2010
;
PTINFORS(BMXY,BMXIEN) ;EP Patient Info Recordset
;
N BMXDPT,BMXZ,BMXDLIM,BMXXX,BMXRET,BMXAGE,BMXNEXT,BMXSEX,BMXERR,BMXHRN
S BMXDLIM="^",BMXERR=""
S BMXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN^T00020AGE^T00080NEXT_APPT^T00010SEX"_$C(30)
I '$D(DUZ(2)) S BMXY=BMXRET_$C(31)_"No DUZ2" Q
I +$G(DUZ) D
. S ^DISV(DUZ,"^AUPNPAT(")=BMXIEN
. S ^DISV(DUZ,"^DPT(")=BMXIEN
I '$D(^DPT(BMXIEN)) S BMXY=BMXRET_$C(31)_"No such patient" Q
S BMXDPT=$G(^DPT(BMXIEN,0))
S BMXZ=$P(BMXDPT,U) ;NAME
;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
;I BMXHRN="" Q ;NO CHART AT THIS DUZ2
I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
S $P(BMXZ,BMXDLIM,2)=BMXHRN
;
S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
S Y=$P(BMXDPT,U,3) X ^DD("DD")
S $P(BMXZ,BMXDLIM,4)=Y ;DOB
S $P(BMXZ,BMXDLIM,5)=BMXIEN
S BMXAGE=$$AGEF^BMXUTL1(BMXIEN)
S $P(BMXZ,BMXDLIM,6)=BMXAGE
S BMXNEXT=$$NEXTAPPT^BMXUTL2(BMXIEN)
S $P(BMXZ,BMXDLIM,7)=BMXNEXT
S BMXSEX=$$SEXW^BMXUTL1(BMXIEN)
S $P(BMXZ,BMXDLIM,8)=BMXSEX
S BMXRET=BMXRET_BMXZ
S BMXY=BMXRET_$C(30)_$C(31)_BMXERR
Q
;
PTLOOKRS(BMXY,BMXP,BMXC) ;EP Patient Lookup
;
;Find up to BMXC patients matching BMXP*
;Supports DOB Lookup, SSN Lookup
;
;S ^HW("PTLOOK","INPUT")=BMXP
;S ^HW("PTLOOK","DUZ2")=$G(DUZ(2))
S BMXP=$TR(BMXP,$C(13),"")
S BMXP=$TR(BMXP,$C(10),"")
S BMXP=$TR(BMXP,$C(9),"")
S:BMXC="" BMXC=10
N BMXHRN,BMXZ,BMXDLIM,BMXRET
S BMXDLIM="^"
S BMXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)
I '+$G(DUZ) S BMXY=BMXRET_$C(31) Q
I '$D(DUZ(2)) S BMXY=BMXRET_$C(31) Q
DOB ;DOB Lookup
I +DUZ(2),((BMXP?1.2N1"/"1.2N1"/"1.4N)!(BMXP?1.2N1" "1.2N1" "1.4N)!(BMXP?1.2N1"-"1.2N1"-"1.4N)) D S BMXY=BMXRET_$C(31) Q
. S X=BMXP S %DT="P" D ^%DT S BMXP=Y Q:'+Y
. Q:'$D(^DPT("ADOB",BMXP))
. S BMXIEN=0,BMXXX=1 F S BMXIEN=$O(^DPT("ADOB",BMXP,BMXIEN)) Q:'+BMXIEN D
. . Q:'$D(^DPT(BMXIEN,0))
. . S BMXDPT=$G(^DPT(BMXIEN,0))
. . S BMXZ=$P(BMXDPT,U) ;NAME
. . ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
. . S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
. . I BMXHRN="" Q ;NO CHART AT THIS DUZ2
. . I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
. . S $P(BMXZ,BMXDLIM,2)=BMXHRN
. . ;
. . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
. . S Y=$P(BMXDPT,U,3) X ^DD("DD")
. . S $P(BMXZ,BMXDLIM,4)=Y ;DOB
. . S $P(BMXZ,BMXDLIM,5)=BMXIEN
. . S BMXXX=BMXXX+1
. . ;S $P(BMXRET,$C(30),BMXXX)=BMXZ
. . S BMXRET=BMXRET_BMXZ_$C(30)
. . Q
. Q
;
;Chart# Lookup
I +DUZ(2),BMXP]"",$D(^AUPNPAT("D",BMXP)) D S BMXY=BMXRET_$C(30)_$C(31) Q
. S BMXIEN=0 F S BMXIEN=$O(^AUPNPAT("D",BMXP,BMXIEN)) Q:'+BMXIEN I $D(^AUPNPAT("D",BMXP,BMXIEN,DUZ(2))) D Q
. . Q:'$D(^DPT(BMXIEN,0))
. . S BMXDPT=$G(^DPT(BMXIEN,0))
. . S BMXZ=$P(BMXDPT,U) ;NAME
. . ;S $P(BMXZ,BMXDLIM,2)=BMXP ;CHART
. . S BMXHRN=BMXP ;CHART
. . I $D(^AUPNPAT(BMXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BMXHRN=BMXHRN_"(*)"
. . S $P(BMXZ,BMXDLIM,2)=BMXHRN
. . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
. . S Y=$P(BMXDPT,U,3) X ^DD("DD")
. . S $P(BMXZ,BMXDLIM,4)=Y ;DOB
. . S $P(BMXZ,BMXDLIM,5)=BMXIEN
. . S $P(BMXRET,$C(30),2)=BMXZ
. . Q
. Q
;
;SSN Lookup
I (BMXP?9N)!(BMXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BMXP)) D S BMXY=BMXRET_$C(30)_$C(31) Q
. S BMXIEN=0 F S BMXIEN=$O(^DPT("SSN",BMXP,BMXIEN)) Q:'+BMXIEN D Q
. . Q:'$D(^DPT(BMXIEN,0))
. . S BMXDPT=$G(^DPT(BMXIEN,0))
. . S BMXZ=$P(BMXDPT,U) ;NAME
. . S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
. . I BMXHRN="" Q ;NO CHART AT THIS DUZ2
. . I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
. . S $P(BMXZ,BMXDLIM,2)=BMXHRN
. . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
. . S Y=$P(BMXDPT,U,3) X ^DD("DD")
. . S $P(BMXZ,BMXDLIM,4)=Y ;DOB
. . S $P(BMXZ,BMXDLIM,5)=BMXIEN
. . S $P(BMXRET,$C(30),2)=BMXZ
. . Q
. Q
;
S BMXFILE=9000001
S BMXIENS=""
S BMXFLDS=".01"
S BMXFLAGS="M"
S BMXVALUE=BMXP
S BMXNMBR=BMXC
S BMXIXS=""
S BMXSCRN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
;I BMXSCRN]"" S DIC("S")=BMXSCRN
;S BMXSCRN="I 0"
S BMXIDEN=""
S BMXTARG="BMXRSLT"
S BMXMSG=""
D FIND^DIC(BMXFILE,BMXIENS,BMXFLDS,BMXFLAGS,BMXVALUE,BMXNMBR,BMXIXS,BMXSCRN,BMXIDEN,BMXTARG,BMXMSG)
;S BMXRET=""
;B
I '+$G(BMXRSLT("DILIST",0)) S BMXY=BMXRET_$C(31) Q
F BMXX=1:1:$P(BMXRSLT("DILIST",0),U) D
. ;B
. S BMXIEN=BMXRSLT("DILIST",2,BMXX)
. S BMXZ=BMXRSLT("DILIST","ID",BMXX,.01) ;NAME
. ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
. S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
. I BMXHRN="" Q ;NO CHART AT THIS DUZ2
. I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
. S $P(BMXZ,BMXDLIM,2)=BMXHRN
. S BMXDPT=$G(^DPT(BMXIEN,0))
. S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
. S Y=$P(BMXDPT,U,3) X ^DD("DD")
. S $P(BMXZ,BMXDLIM,4)=Y ;DOB
. S $P(BMXZ,BMXDLIM,5)=BMXIEN
. S $P(BMXRET,$C(30),BMXX+1)=BMXZ
. Q
;K BMXRSLT
S BMXY=BMXRET_$C(30)_$C(31)
Q
ZZZ ;
BMXRPC4 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;
PTINFORS(BMXY,BMXIEN) ;EP Patient Info Recordset
+1 ;
+2 NEW BMXDPT,BMXZ,BMXDLIM,BMXXX,BMXRET,BMXAGE,BMXNEXT,BMXSEX,BMXERR,BMXHRN
+3 SET BMXDLIM="^"
SET BMXERR=""
+4 SET BMXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN^T00020AGE^T00080NEXT_APPT^T00010SEX"_$CHAR(30)
+5 IF '$DATA(DUZ(2))
SET BMXY=BMXRET_$CHAR(31)_"No DUZ2"
QUIT
+6 IF +$GET(DUZ)
Begin DoDot:1
+7 SET ^DISV(DUZ,"^AUPNPAT(")=BMXIEN
+8 SET ^DISV(DUZ,"^DPT(")=BMXIEN
End DoDot:1
+9 IF '$DATA(^DPT(BMXIEN))
SET BMXY=BMXRET_$CHAR(31)_"No such patient"
QUIT
+10 SET BMXDPT=$GET(^DPT(BMXIEN,0))
+11 ;NAME
SET BMXZ=$PIECE(BMXDPT,U)
+12 ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
+13 ;CHART
SET BMXHRN=$PIECE($GET(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2)
+14 ;I BMXHRN="" Q ;NO CHART AT THIS DUZ2
+15 IF $PIECE($GET(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3)
SET BMXHRN=BMXHRN_"(*)"
+16 SET $PIECE(BMXZ,BMXDLIM,2)=BMXHRN
+17 ;
+18 ;SSN
SET $PIECE(BMXZ,BMXDLIM,3)=$PIECE(BMXDPT,U,9)
+19 SET Y=$PIECE(BMXDPT,U,3)
XECUTE ^DD("DD")
+20 ;DOB
SET $PIECE(BMXZ,BMXDLIM,4)=Y
+21 SET $PIECE(BMXZ,BMXDLIM,5)=BMXIEN
+22 SET BMXAGE=$$AGEF^BMXUTL1(BMXIEN)
+23 SET $PIECE(BMXZ,BMXDLIM,6)=BMXAGE
+24 SET BMXNEXT=$$NEXTAPPT^BMXUTL2(BMXIEN)
+25 SET $PIECE(BMXZ,BMXDLIM,7)=BMXNEXT
+26 SET BMXSEX=$$SEXW^BMXUTL1(BMXIEN)
+27 SET $PIECE(BMXZ,BMXDLIM,8)=BMXSEX
+28 SET BMXRET=BMXRET_BMXZ
+29 SET BMXY=BMXRET_$CHAR(30)_$CHAR(31)_BMXERR
+30 QUIT
+31 ;
PTLOOKRS(BMXY,BMXP,BMXC) ;EP Patient Lookup
+1 ;
+2 ;Find up to BMXC patients matching BMXP*
+3 ;Supports DOB Lookup, SSN Lookup
+4 ;
+5 ;S ^HW("PTLOOK","INPUT")=BMXP
+6 ;S ^HW("PTLOOK","DUZ2")=$G(DUZ(2))
+7 SET BMXP=$TRANSLATE(BMXP,$CHAR(13),"")
+8 SET BMXP=$TRANSLATE(BMXP,$CHAR(10),"")
+9 SET BMXP=$TRANSLATE(BMXP,$CHAR(9),"")
+10 IF BMXC=""
SET BMXC=10
+11 NEW BMXHRN,BMXZ,BMXDLIM,BMXRET
+12 SET BMXDLIM="^"
+13 SET BMXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$CHAR(30)
+14 IF '+$GET(DUZ)
SET BMXY=BMXRET_$CHAR(31)
QUIT
+15 IF '$DATA(DUZ(2))
SET BMXY=BMXRET_$CHAR(31)
QUIT
DOB ;DOB Lookup
+1 IF +DUZ(2)
IF ((BMXP?1.2N1"/"1.2N1"/"1.4N)!(BMXP?1.2N1" "1.2N1" "1.4N)!(BMXP?1.2N1"-"1.2N1"-"1.4N))
Begin DoDot:1
+2 SET X=BMXP
SET %DT="P"
DO ^%DT
SET BMXP=Y
IF '+Y
QUIT
+3 IF '$DATA(^DPT("ADOB",BMXP))
QUIT
+4 SET BMXIEN=0
SET BMXXX=1
FOR
SET BMXIEN=$ORDER(^DPT("ADOB",BMXP,BMXIEN))
IF '+BMXIEN
QUIT
Begin DoDot:2
+5 IF '$DATA(^DPT(BMXIEN,0))
QUIT
+6 SET BMXDPT=$GET(^DPT(BMXIEN,0))
+7 ;NAME
SET BMXZ=$PIECE(BMXDPT,U)
+8 ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
+9 ;CHART
SET BMXHRN=$PIECE($GET(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2)
+10 ;NO CHART AT THIS DUZ2
IF BMXHRN=""
QUIT
+11 IF $PIECE($GET(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3)
SET BMXHRN=BMXHRN_"(*)"
+12 SET $PIECE(BMXZ,BMXDLIM,2)=BMXHRN
+13 ;
+14 ;SSN
SET $PIECE(BMXZ,BMXDLIM,3)=$PIECE(BMXDPT,U,9)
+15 SET Y=$PIECE(BMXDPT,U,3)
XECUTE ^DD("DD")
+16 ;DOB
SET $PIECE(BMXZ,BMXDLIM,4)=Y
+17 SET $PIECE(BMXZ,BMXDLIM,5)=BMXIEN
+18 SET BMXXX=BMXXX+1
+19 ;S $P(BMXRET,$C(30),BMXXX)=BMXZ
+20 SET BMXRET=BMXRET_BMXZ_$CHAR(30)
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
SET BMXY=BMXRET_$CHAR(31)
QUIT
+23 ;
+24 ;Chart# Lookup
+25 IF +DUZ(2)
IF BMXP]""
IF $DATA(^AUPNPAT("D",BMXP))
Begin DoDot:1
+26 SET BMXIEN=0
FOR
SET BMXIEN=$ORDER(^AUPNPAT("D",BMXP,BMXIEN))
IF '+BMXIEN
QUIT
IF $DATA(^AUPNPAT("D",BMXP,BMXIEN,DUZ(2)))
Begin DoDot:2
+27 IF '$DATA(^DPT(BMXIEN,0))
QUIT
+28 SET BMXDPT=$GET(^DPT(BMXIEN,0))
+29 ;NAME
SET BMXZ=$PIECE(BMXDPT,U)
+30 ;S $P(BMXZ,BMXDLIM,2)=BMXP ;CHART
+31 ;CHART
SET BMXHRN=BMXP
+32 IF $DATA(^AUPNPAT(BMXIEN,41,DUZ(2),0))
IF $PIECE(^(0),U,3)
SET BMXHRN=BMXHRN_"(*)"
+33 SET $PIECE(BMXZ,BMXDLIM,2)=BMXHRN
+34 ;SSN
SET $PIECE(BMXZ,BMXDLIM,3)=$PIECE(BMXDPT,U,9)
+35 SET Y=$PIECE(BMXDPT,U,3)
XECUTE ^DD("DD")
+36 ;DOB
SET $PIECE(BMXZ,BMXDLIM,4)=Y
+37 SET $PIECE(BMXZ,BMXDLIM,5)=BMXIEN
+38 SET $PIECE(BMXRET,$CHAR(30),2)=BMXZ
+39 QUIT
End DoDot:2
QUIT
+40 QUIT
End DoDot:1
SET BMXY=BMXRET_$CHAR(30)_$CHAR(31)
QUIT
+41 ;
+42 ;SSN Lookup
+43 IF (BMXP?9N)!(BMXP?3N1"-"2N1"-"4N)
IF $DATA(^DPT("SSN",BMXP))
Begin DoDot:1
+44 SET BMXIEN=0
FOR
SET BMXIEN=$ORDER(^DPT("SSN",BMXP,BMXIEN))
IF '+BMXIEN
QUIT
Begin DoDot:2
+45 IF '$DATA(^DPT(BMXIEN,0))
QUIT
+46 SET BMXDPT=$GET(^DPT(BMXIEN,0))
+47 ;NAME
SET BMXZ=$PIECE(BMXDPT,U)
+48 ;CHART
SET BMXHRN=$PIECE($GET(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2)
+49 ;NO CHART AT THIS DUZ2
IF BMXHRN=""
QUIT
+50 IF $PIECE($GET(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3)
SET BMXHRN=BMXHRN_"(*)"
+51 SET $PIECE(BMXZ,BMXDLIM,2)=BMXHRN
+52 ;SSN
SET $PIECE(BMXZ,BMXDLIM,3)=$PIECE(BMXDPT,U,9)
+53 SET Y=$PIECE(BMXDPT,U,3)
XECUTE ^DD("DD")
+54 ;DOB
SET $PIECE(BMXZ,BMXDLIM,4)=Y
+55 SET $PIECE(BMXZ,BMXDLIM,5)=BMXIEN
+56 SET $PIECE(BMXRET,$CHAR(30),2)=BMXZ
+57 QUIT
End DoDot:2
QUIT
+58 QUIT
End DoDot:1
SET BMXY=BMXRET_$CHAR(30)_$CHAR(31)
QUIT
+59 ;
+60 SET BMXFILE=9000001
+61 SET BMXIENS=""
+62 SET BMXFLDS=".01"
+63 SET BMXFLAGS="M"
+64 SET BMXVALUE=BMXP
+65 SET BMXNMBR=BMXC
+66 SET BMXIXS=""
+67 SET BMXSCRN=$SELECT(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
+68 ;I BMXSCRN]"" S DIC("S")=BMXSCRN
+69 ;S BMXSCRN="I 0"
+70 SET BMXIDEN=""
+71 SET BMXTARG="BMXRSLT"
+72 SET BMXMSG=""
+73 DO FIND^DIC(BMXFILE,BMXIENS,BMXFLDS,BMXFLAGS,BMXVALUE,BMXNMBR,BMXIXS,BMXSCRN,BMXIDEN,BMXTARG,BMXMSG)
+74 ;S BMXRET=""
+75 ;B
+76 IF '+$GET(BMXRSLT("DILIST",0))
SET BMXY=BMXRET_$CHAR(31)
QUIT
+77 FOR BMXX=1:1:$PIECE(BMXRSLT("DILIST",0),U)
Begin DoDot:1
+78 ;B
+79 SET BMXIEN=BMXRSLT("DILIST",2,BMXX)
+80 ;NAME
SET BMXZ=BMXRSLT("DILIST","ID",BMXX,.01)
+81 ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
+82 ;CHART
SET BMXHRN=$PIECE($GET(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2)
+83 ;NO CHART AT THIS DUZ2
IF BMXHRN=""
QUIT
+84 IF $PIECE($GET(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3)
SET BMXHRN=BMXHRN_"(*)"
+85 SET $PIECE(BMXZ,BMXDLIM,2)=BMXHRN
+86 SET BMXDPT=$GET(^DPT(BMXIEN,0))
+87 ;SSN
SET $PIECE(BMXZ,BMXDLIM,3)=$PIECE(BMXDPT,U,9)
+88 SET Y=$PIECE(BMXDPT,U,3)
XECUTE ^DD("DD")
+89 ;DOB
SET $PIECE(BMXZ,BMXDLIM,4)=Y
+90 SET $PIECE(BMXZ,BMXDLIM,5)=BMXIEN
+91 SET $PIECE(BMXRET,$CHAR(30),BMXX+1)=BMXZ
+92 QUIT
End DoDot:1
+93 ;K BMXRSLT
+94 SET BMXY=BMXRET_$CHAR(30)_$CHAR(31)
+95 QUIT
ZZZ ;
