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

BSDSCRPC.m

Go to the documentation of this file. 
  1. BSDSCRPC ; IHS/ANMC/LJF - MODS TO PCMM RPC CALLS ; 
  1.  ;;5.3;PIMS;;APR 26, 2002
  1.  ;
  1. PTLOOKUP(BSDV,BSDC) ;EP; called by FINDP^SCUTBK11 for IHS patient lookup
  1.  ; uses code that converts answer to what SCUTBK11 wants
  1.  ;
  1.  ; BSDV = input value sent
  1.  ; BSDC = count of values to return
  1.  ;
  1.  NEW BSDA,I,X,Y
  1.  D LOOKUP(.BSDA,.BSDV,.BSDC)
  1.  K ^TMP("DILIST",$J)
  1.  F I=2:1 S Y=$P(BSDA,$C(30),I) Q:Y=$C(31)  D
  1.  . ;  convert name^hrcn^ssn^dob^ien to ien^name^dob  hrcn^pt id
  1.  . S X=$P(Y,U,5)_U_$P(Y,U)_U_$P(Y,U,4)_$J($P(Y,U,2),10)_U_$P(Y,U,2)
  1.  . S ^TMP("DILIST",$J,I-1,0)=X
  1.  Q
  1.  ;
  1. LOOKUP(BSDY,BSDP,BSDC)  ; Patient Lookup
  1.  ;code blatently stolen from Horace Whitt (PTLOOKRS^BMXRPC4)
  1.  ;
  1.  ;Find up to BSDC patients matching BSDP*
  1.  ;Supports DOB Lookup, SSN Lookup
  1.  ;
  1.  S BSDP=$TR(BSDP,$C(13),"")
  1.  S BSDP=$TR(BSDP,$C(10),"")
  1.  S BSDP=$TR(BSDP,$C(9),"")
  1.  S:BSDC="" BSDC=10
  1.  N BSDHRN,BSDZ,BSDDLIM,BSDRET
  1.  S BSDDLIM="^"
  1.  S BSDRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)
  1.  I '+$G(DUZ) S BSDY=BSDRET_$C(31) Q
  1.  I '$D(DUZ(2)) S BSDY=BSDRET_$C(31) Q
  1.  ;
  1. DOB ;DOB Lookup
  1.  I +DUZ(2),((BSDP?1.2N1"/"1.2N1"/"1.4N)!(BSDP?1.2N1" "1.2N1" "1.4N)!(BSDP?1.2N1"-"1.2N1"-"1.4N)) D  S BSDY=BSDRET_$C(31) Q
  1.  . S X=BSDP S %DT="P" D ^%DT S BSDP=Y Q:'+Y
  1.  . Q:'$D(^DPT("ADOB",BSDP))
  1.  . S BSDIEN=0,BSDXX=1 F  S BSDIEN=$O(^DPT("ADOB",BSDP,BSDIEN)) Q:'+BSDIEN  D
  1.  . . Q:'$D(^DPT(BSDIEN,0))
  1.  . . S BSDDPT=$G(^DPT(BSDIEN,0))
  1.  . . S BSDZ=$P(BSDDPT,U)  ;NAME
  1.  . . S BSDHRN=$P($G(^AUPNPAT(BSDIEN,41,DUZ(2),0)),U,2)  ;CHART
  1.  . . I BSDHRN="" Q  ;NO CHART AT THIS DUZ2
  1.  . . I $P($G(^AUPNPAT(BSDIEN,41,DUZ(2),0)),U,3) S BSDHRN=BSDHRN_"(*)"
  1.  . . S $P(BSDZ,BSDDLIM,2)=BSDHRN
  1.  . . ;
  1.  . . S $P(BSDZ,BSDDLIM,3)=$P(BSDDPT,U,9)  ;SSN
  1.  . . S Y=$P(BSDDPT,U,3) X ^DD("DD")
  1.  . . S $P(BSDZ,BSDDLIM,4)=Y ;DOB
  1.  . . S $P(BSDZ,BSDDLIM,5)=BSDIEN
  1.  . . S BSDXX=BSDXX+1
  1.  . . S BSDRET=BSDRET_BSDZ_$C(30)
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ;Chart# Lookup
  1.  I +DUZ(2),BSDP]"",$D(^AUPNPAT("D",BSDP)) D  S BSDY=BSDRET_$C(30)_$C(31) Q
  1.  . S BSDIEN=0 F  S BSDIEN=$O(^AUPNPAT("D",BSDP,BSDIEN)) Q:'+BSDIEN  I $D(^AUPNPAT("D",BSDP,BSDIEN,DUZ(2))) D  Q
  1.  . . Q:'$D(^DPT(BSDIEN,0))
  1.  . . S BSDDPT=$G(^DPT(BSDIEN,0))
  1.  . . S BSDZ=$P(BSDDPT,U)  ;NAME
  1.  . . S BSDHRN=BSDP ;CHART
  1.  . . I $D(^AUPNPAT(BSDIEN,41,DUZ(2),0)),$P(^(0),U,3) S BSDHRN=BSDHRN_"(*)"
  1.  . . S $P(BSDZ,BSDDLIM,2)=BSDHRN
  1.  . . S $P(BSDZ,BSDDLIM,3)=$P(BSDDPT,U,9)  ;SSN
  1.  . . S Y=$P(BSDDPT,U,3) X ^DD("DD")
  1.  . . S $P(BSDZ,BSDDLIM,4)=Y ;DOB
  1.  . . S $P(BSDZ,BSDDLIM,5)=BSDIEN
  1.  . . S $P(BSDRET,$C(30),2)=BSDZ
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ;SSN Lookup
  1.  I (BSDP?9N)!(BSDP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BSDP)) D  S BSDY=BSDRET_$C(30)_$C(31) Q
  1.  . S BSDIEN=0 F  S BSDIEN=$O(^DPT("SSN",BSDP,BSDIEN)) Q:'+BSDIEN  D  Q
  1.  . . Q:'$D(^DPT(BSDIEN,0))
  1.  . . S BSDDPT=$G(^DPT(BSDIEN,0))
  1.  . . S BSDZ=$P(BSDDPT,U)  ;NAME
  1.  . . S BSDHRN=$P($G(^AUPNPAT(BSDIEN,41,DUZ(2),0)),U,2)  ;CHART
  1.  . . I BSDHRN="" Q  ;NO CHART AT THIS DUZ2
  1.  . . I $P($G(^AUPNPAT(BSDIEN,41,DUZ(2),0)),U,3) S BSDHRN=BSDHRN_"(*)"
  1.  . . S $P(BSDZ,BSDDLIM,2)=BSDHRN
  1.  . . S $P(BSDZ,BSDDLIM,3)=$P(BSDDPT,U,9)  ;SSN
  1.  . . S Y=$P(BSDDPT,U,3) X ^DD("DD")
  1.  . . S $P(BSDZ,BSDDLIM,4)=Y ;DOB
  1.  . . S $P(BSDZ,BSDDLIM,5)=BSDIEN
  1.  . . S $P(BSDRET,$C(30),2)=BSDZ
  1.  . . Q
  1.  . Q
  1.  ;
  1.  S BSDFILE=9000001
  1.  S BSDIENS=""
  1.  S BSDFIELD=".01"
  1.  S BSDFLAGS="M"
  1.  S BSDVALUE=BSDP
  1.  S BSDNUMBR=BSDC
  1.  S BSDINDEX=""
  1.  S BSDSCREN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
  1.  S BSDIDEN=""
  1.  S BSDTARG="BSDRSLT"
  1.  S BSDMSG=""
  1.  D FIND^DIC(BSDFILE,BSDIENS,BSDFIELD,BSDFLAGS,BSDVALUE,BSDNUMBR,BSDINDEX,BSDSCREN,BSDIDEN,BSDTARG,BSDMSG)
  1.  I '+$G(BSDRSLT("DILIST",0)) S BSDY=BSDRET_$C(31) Q
  1.  F BSDX=1:1:$P(BSDRSLT("DILIST",0),U) D
  1.  . S BSDIEN=BSDRSLT("DILIST",2,BSDX)
  1.  . S BSDZ=BSDRSLT("DILIST","ID",BSDX,.01)  ;NAME
  1.  . S BSDHRN=$P($G(^AUPNPAT(BSDIEN,41,DUZ(2),0)),U,2)  ;CHART
  1.  . I BSDHRN="" Q  ;NO CHART AT THIS DUZ2
  1.  . I $P($G(^AUPNPAT(BSDIEN,41,DUZ(2),0)),U,3) S BSDHRN=BSDHRN_"(*)"
  1.  . S $P(BSDZ,BSDDLIM,2)=BSDHRN
  1.  . S BSDDPT=$G(^DPT(BSDIEN,0))
  1.  . S $P(BSDZ,BSDDLIM,3)=$P(BSDDPT,U,9)  ;SSN
  1.  . S Y=$P(BSDDPT,U,3) X ^DD("DD")
  1.  . S $P(BSDZ,BSDDLIM,4)=Y ;DOB
  1.  . S $P(BSDZ,BSDDLIM,5)=BSDIEN
  1.  . S $P(BSDRET,$C(30),BSDX+1)=BSDZ
  1.  . Q
  1.  S BSDY=BSDRET_$C(30)_$C(31)
  1.  Q