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

BMXRPC4.m

Go to the documentation of this file. 
  1. BMXRPC4 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
  1.  ;;4.0;BMX;;JUN 28, 2010
  1.  ;
  1. PTINFORS(BMXY,BMXIEN)        ;EP Patient Info Recordset
  1.  ;
  1.  N BMXDPT,BMXZ,BMXDLIM,BMXXX,BMXRET,BMXAGE,BMXNEXT,BMXSEX,BMXERR,BMXHRN
  1.  S BMXDLIM="^",BMXERR=""
  1.  S BMXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN^T00020AGE^T00080NEXT_APPT^T00010SEX"_$C(30)
  1.  I '$D(DUZ(2)) S BMXY=BMXRET_$C(31)_"No DUZ2" Q
  1.  I +$G(DUZ) D
  1.  . S ^DISV(DUZ,"^AUPNPAT(")=BMXIEN
  1.  . S ^DISV(DUZ,"^DPT(")=BMXIEN
  1.  I '$D(^DPT(BMXIEN)) S BMXY=BMXRET_$C(31)_"No such patient" Q
  1.  S BMXDPT=$G(^DPT(BMXIEN,0))
  1.  S BMXZ=$P(BMXDPT,U) ;NAME
  1.  ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
  1.  S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
  1.  ;I BMXHRN="" Q  ;NO CHART AT THIS DUZ2
  1.  I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
  1.  S $P(BMXZ,BMXDLIM,2)=BMXHRN
  1.  ;
  1.  S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
  1.  S Y=$P(BMXDPT,U,3) X ^DD("DD")
  1.  S $P(BMXZ,BMXDLIM,4)=Y ;DOB
  1.  S $P(BMXZ,BMXDLIM,5)=BMXIEN
  1.  S BMXAGE=$$AGEF^BMXUTL1(BMXIEN)
  1.  S $P(BMXZ,BMXDLIM,6)=BMXAGE
  1.  S BMXNEXT=$$NEXTAPPT^BMXUTL2(BMXIEN)
  1.  S $P(BMXZ,BMXDLIM,7)=BMXNEXT
  1.  S BMXSEX=$$SEXW^BMXUTL1(BMXIEN)
  1.  S $P(BMXZ,BMXDLIM,8)=BMXSEX
  1.  S BMXRET=BMXRET_BMXZ
  1.  S BMXY=BMXRET_$C(30)_$C(31)_BMXERR
  1.  Q
  1.  ;
  1. PTLOOKRS(BMXY,BMXP,BMXC)  ;EP Patient Lookup
  1.  ;
  1.  ;Find up to BMXC patients matching BMXP*
  1.  ;Supports DOB Lookup, SSN Lookup
  1.  ;
  1.  ;S ^HW("PTLOOK","INPUT")=BMXP
  1.  ;S ^HW("PTLOOK","DUZ2")=$G(DUZ(2))
  1.  S BMXP=$TR(BMXP,$C(13),"")
  1.  S BMXP=$TR(BMXP,$C(10),"")
  1.  S BMXP=$TR(BMXP,$C(9),"")
  1.  S:BMXC="" BMXC=10
  1.  N BMXHRN,BMXZ,BMXDLIM,BMXRET
  1.  S BMXDLIM="^"
  1.  S BMXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)
  1.  I '+$G(DUZ) S BMXY=BMXRET_$C(31) Q
  1.  I '$D(DUZ(2)) S BMXY=BMXRET_$C(31) Q
  1. DOB ;DOB Lookup
  1.  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
  1.  . S X=BMXP S %DT="P" D ^%DT S BMXP=Y Q:'+Y
  1.  . Q:'$D(^DPT("ADOB",BMXP))
  1.  . S BMXIEN=0,BMXXX=1 F  S BMXIEN=$O(^DPT("ADOB",BMXP,BMXIEN)) Q:'+BMXIEN  D
  1.  . . Q:'$D(^DPT(BMXIEN,0))
  1.  . . S BMXDPT=$G(^DPT(BMXIEN,0))
  1.  . . S BMXZ=$P(BMXDPT,U) ;NAME
  1.  . . ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
  1.  . . S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
  1.  . . I BMXHRN="" Q  ;NO CHART AT THIS DUZ2
  1.  . . I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
  1.  . . S $P(BMXZ,BMXDLIM,2)=BMXHRN
  1.  . . ;
  1.  . . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
  1.  . . S Y=$P(BMXDPT,U,3) X ^DD("DD")
  1.  . . S $P(BMXZ,BMXDLIM,4)=Y ;DOB
  1.  . . S $P(BMXZ,BMXDLIM,5)=BMXIEN
  1.  . . S BMXXX=BMXXX+1
  1.  . . ;S $P(BMXRET,$C(30),BMXXX)=BMXZ
  1.  . . S BMXRET=BMXRET_BMXZ_$C(30)
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ;Chart# Lookup
  1.  I +DUZ(2),BMXP]"",$D(^AUPNPAT("D",BMXP)) D  S BMXY=BMXRET_$C(30)_$C(31) Q
  1.  . S BMXIEN=0 F  S BMXIEN=$O(^AUPNPAT("D",BMXP,BMXIEN)) Q:'+BMXIEN  I $D(^AUPNPAT("D",BMXP,BMXIEN,DUZ(2))) D  Q
  1.  . . Q:'$D(^DPT(BMXIEN,0))
  1.  . . S BMXDPT=$G(^DPT(BMXIEN,0))
  1.  . . S BMXZ=$P(BMXDPT,U) ;NAME
  1.  . . ;S $P(BMXZ,BMXDLIM,2)=BMXP ;CHART
  1.  . . S BMXHRN=BMXP ;CHART
  1.  . . I $D(^AUPNPAT(BMXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BMXHRN=BMXHRN_"(*)"
  1.  . . S $P(BMXZ,BMXDLIM,2)=BMXHRN
  1.  . . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
  1.  . . S Y=$P(BMXDPT,U,3) X ^DD("DD")
  1.  . . S $P(BMXZ,BMXDLIM,4)=Y ;DOB
  1.  . . S $P(BMXZ,BMXDLIM,5)=BMXIEN
  1.  . . S $P(BMXRET,$C(30),2)=BMXZ
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ;SSN Lookup
  1.  I (BMXP?9N)!(BMXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BMXP)) D  S BMXY=BMXRET_$C(30)_$C(31) Q
  1.  . S BMXIEN=0 F  S BMXIEN=$O(^DPT("SSN",BMXP,BMXIEN)) Q:'+BMXIEN  D  Q
  1.  . . Q:'$D(^DPT(BMXIEN,0))
  1.  . . S BMXDPT=$G(^DPT(BMXIEN,0))
  1.  . . S BMXZ=$P(BMXDPT,U) ;NAME
  1.  . . S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
  1.  . . I BMXHRN="" Q  ;NO CHART AT THIS DUZ2
  1.  . . I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
  1.  . . S $P(BMXZ,BMXDLIM,2)=BMXHRN
  1.  . . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
  1.  . . S Y=$P(BMXDPT,U,3) X ^DD("DD")
  1.  . . S $P(BMXZ,BMXDLIM,4)=Y ;DOB
  1.  . . S $P(BMXZ,BMXDLIM,5)=BMXIEN
  1.  . . S $P(BMXRET,$C(30),2)=BMXZ
  1.  . . Q
  1.  . Q
  1.  ;
  1.  S BMXFILE=9000001
  1.  S BMXIENS=""
  1.  S BMXFLDS=".01"
  1.  S BMXFLAGS="M"
  1.  S BMXVALUE=BMXP
  1.  S BMXNMBR=BMXC
  1.  S BMXIXS=""
  1.  S BMXSCRN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
  1.  ;I BMXSCRN]"" S DIC("S")=BMXSCRN
  1.  ;S BMXSCRN="I 0"
  1.  S BMXIDEN=""
  1.  S BMXTARG="BMXRSLT"
  1.  S BMXMSG=""
  1.  D FIND^DIC(BMXFILE,BMXIENS,BMXFLDS,BMXFLAGS,BMXVALUE,BMXNMBR,BMXIXS,BMXSCRN,BMXIDEN,BMXTARG,BMXMSG)
  1.  ;S BMXRET=""
  1.  ;B
  1.  I '+$G(BMXRSLT("DILIST",0)) S BMXY=BMXRET_$C(31) Q
  1.  F BMXX=1:1:$P(BMXRSLT("DILIST",0),U) D
  1.  . ;B
  1.  . S BMXIEN=BMXRSLT("DILIST",2,BMXX)
  1.  . S BMXZ=BMXRSLT("DILIST","ID",BMXX,.01) ;NAME
  1.  . ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
  1.  . S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
  1.  . I BMXHRN="" Q  ;NO CHART AT THIS DUZ2
  1.  . I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
  1.  . S $P(BMXZ,BMXDLIM,2)=BMXHRN
  1.  . S BMXDPT=$G(^DPT(BMXIEN,0))
  1.  . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
  1.  . S Y=$P(BMXDPT,U,3) X ^DD("DD")
  1.  . S $P(BMXZ,BMXDLIM,4)=Y ;DOB
  1.  . S $P(BMXZ,BMXDLIM,5)=BMXIEN
  1.  . S $P(BMXRET,$C(30),BMXX+1)=BMXZ
  1.  . Q
  1.  ;K BMXRSLT
  1.  S BMXY=BMXRET_$C(30)_$C(31)
  1.  Q
  1. ZZZ ;