source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC4.m@ 1549

BMXRPC4 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
        ;;2.31;BMX;;Jul 25, 2011
        ;
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 BMXFIELDS=".01"
        S BMXFLAGS="M"
        S BMXVALUE=BMXP
        S BMXNUMBER=BMXC
        S BMXINDEXES=""
        S BMXSCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
        ;I BMXSCREEN]"" S DIC("S")=BMXSCREEN
        ;S BMXSCREEN="I 0"
        S BMXIDEN=""
        S BMXTARG="BMXRSLT"
        S BMXMSG=""
        D FIND^DIC(BMXFILE,BMXIENS,BMXFIELDS,BMXFLAGS,BMXVALUE,BMXNUMBER,BMXINDEXES,BMXSCREEN,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     ;