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

BSDX28.m

Go to the documentation of this file. 
  1. BSDX28 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
  1.  ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
  1.  ;
  1.  ;HMW 20050721 Added test for inactivated record
  1.  ;
  1. PTLOOKRS(BSDXY,BSDXP,BSDXC)  ;EP Patient Lookup
  1.  ;
  1.  ;Called by BSDXPatientLookupRS
  1.  ;Find up to BSDXC patients matching BSDXP*
  1.  ;Supports DOB Lookup, SSN Lookup
  1.  ;
  1.  ;S X="ERROR^BSDX28",@^%ZOSF("TRAP")
  1.  S BSDXP=$TR(BSDXP,$C(13),"")
  1.  S BSDXP=$TR(BSDXP,$C(10),"")
  1.  S BSDXP=$TR(BSDXP,$C(9),"")
  1.  S:BSDXC="" BSDXC=10
  1.  N BSDXHRN,BSDXZ,BSDXDLIM,BSDXRET,BSDXDPT,BSDXRET,BSDXIEN,BSDXFILE
  1.  N BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN
  1.  N BSDXTARG,BSDXMSG,BSDXRSLT,BSDXCNT
  1.  S BSDXDLIM="^"
  1.  S BSDXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)
  1.  I '+$G(DUZ) S BSDXY=BSDXRET_$C(31) Q
  1.  I '$D(DUZ(2)) S BSDXY=BSDXRET_$C(31) Q
  1.  ;
  1. DOB ;DOB Lookup
  1.  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
  1.  . S X=BSDXP S %DT="P" D ^%DT S BSDXP=Y Q:'+Y
  1.  . Q:'$D(^DPT("ADOB",BSDXP))
  1.  . S BSDXIEN=0 F  S BSDXIEN=$O(^DPT("ADOB",BSDXP,BSDXIEN)) Q:'+BSDXIEN  D
  1.  . . Q:'$D(^DPT(BSDXIEN,0))
  1.  . . S BSDXDPT=$G(^DPT(BSDXIEN,0))
  1.  . . S BSDXZ=$P(BSDXDPT,U) ;NAME
  1.  . . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
  1.  . . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
  1.  . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
  1.  . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
  1.  . . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
  1.  . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
  1.  . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
  1.  . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
  1.  . . S BSDXRET=BSDXRET_BSDXZ_$C(30)
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ;Chart# Lookup
  1.  I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D  S BSDXY=BSDXRET_$C(31) Q
  1.  . S BSDXIEN=0 F  S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN  I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D  Q
  1.  . . Q:'$D(^DPT(BSDXIEN,0))
  1.  . . S BSDXDPT=$G(^DPT(BSDXIEN,0))
  1.  . . S BSDXZ=$P(BSDXDPT,U) ;NAME
  1.  . . S BSDXHRN=BSDXP ;CHART
  1.  . . I $D(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
  1.  . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
  1.  . . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
  1.  . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
  1.  . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
  1.  . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
  1.  . . S BSDXRET=BSDXRET_BSDXZ_$C(30)
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ;SSN Lookup
  1.  I (BSDXP?9N)!(BSDXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BSDXP)) D  S BSDXY=BSDXRET_$C(31) Q
  1.  . S BSDXIEN=0 F  S BSDXIEN=$O(^DPT("SSN",BSDXP,BSDXIEN)) Q:'+BSDXIEN  D  Q
  1.  . . Q:'$D(^DPT(BSDXIEN,0))
  1.  . . S BSDXDPT=$G(^DPT(BSDXIEN,0))
  1.  . . S BSDXZ=$P(BSDXDPT,U) ;NAME
  1.  . . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
  1.  . . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
  1.  . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
  1.  . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
  1.  . . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
  1.  . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
  1.  . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
  1.  . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
  1.  . . S BSDXRET=BSDXRET_BSDXZ_$C(30)
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ;All Patients
  1.  I BSDXP="" D  S BSDXY=BSDXRET_$C(31) Q
  1.  . D LISTALL^BEHOPTPL(.PLIST,"",1)
  1.  . S BSDXCNT=0 F  S BSDXCNT=$O(PLIST(BSDXCNT)) Q:'BSDXCNT  D
  1.  . . S BSDXIEN=$P(PLIST(BSDXCNT),U)
  1.  . . S BSDXDPT=$G(^DPT(BSDXIEN,0))
  1.  . . S BSDXZ=$P(BSDXDPT,U)
  1.  . . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
  1.  . . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
  1.  . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
  1.  . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
  1.  . . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
  1.  . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
  1.  . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
  1.  . . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
  1.  . . S BSDXRET=BSDXRET_BSDXZ_$C(30)
  1.  . . Q
  1.  . Q
  1.  ;
  1.  S BSDXFILE=9000001
  1.  S BSDXIENS=""
  1.  S BSDXFIELDS=".01"
  1.  S BSDXFLAGS="M"
  1.  S BSDXVALUE=BSDXP
  1.  S BSDXNUMBER=BSDXC
  1.  S BSDXINDEXES=""
  1.  S BSDXSCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
  1.  S BSDXIDEN=""
  1.  S BSDXTARG="BSDXRSLT"
  1.  S BSDXMSG=""
  1.  D FIND^DIC(BSDXFILE,BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN,BSDXIDEN,BSDXTARG,BSDXMSG)
  1.  I '+$G(BSDXRSLT("DILIST",0)) S BSDXY=BSDXRET_$C(31) Q
  1.  N BSDXCNT S BSDXCNT=2
  1.  F BSDXX=1:1:$P(BSDXRSLT("DILIST",0),U) D
  1.  . S BSDXIEN=BSDXRSLT("DILIST",2,BSDXX)
  1.  . S BSDXZ=BSDXRSLT("DILIST","ID",BSDXX,.01) ;NAME
  1.  . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
  1.  . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
  1.  . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
  1.  . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
  1.  . S BSDXDPT=$G(^DPT(BSDXIEN,0))
  1.  . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
  1.  . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
  1.  . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
  1.  . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
  1.  . S $P(BSDXRET,$C(30),BSDXCNT)=BSDXZ
  1.  . S BSDXCNT=BSDXCNT+1
  1.  . Q
  1.  S BSDXY=BSDXRET_$C(30)_$C(31)
  1.  Q
  1.  ;
  1. ERROR ;
  1.  D ERR("RPMS Error")
  1.  Q
  1.  ;
  1. ERR(ERRNO) ;Error processing
  1.  S BSDXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)_"^^^^"_$C(30)_$C(31)
  1.  Q