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

BGUGPLK.m

Go to the documentation of this file. 
  1. BGUGPLK ; IHS/OIT/MJL - GENERAL PATIENT LOOKUP FOR BGU WINDOWS ;
  1.  ;;1.5;BGU;;MAY 26, 2005
  1.  ;
  1.  ;===================================================================
  1. PTLIST(RESULT,BGUGX,BGUGMAX,BGUGMORE,BGUGPRAM)        ;EP-get list of patients and pass back
  1.  ; INPUTS :
  1.  ;      BGUGX = SEARCH-KEY
  1.  ;    BGUGMAX = max number of returned matches
  1.  ;   BGUGMORE = MORE STARTING FLAG
  1.  ;   BGUGPRAM = PARAM FOR LATER USE
  1.  ; SEARCH-KEY = used to limit the search.
  1.  ;            = partial last name - use B cross ref.
  1.  ;                   - RETURNS A LIST using B cross ref value.
  1.  ;            = 1st letter of LAST name +  4 digits of SSN- DPT("BS5"
  1.  ;                   - RETURNS A LIST
  1.  ;            = DOB   - ^DPT("ADOB",DOB
  1.  ;                   - RETURNS EXACT FIND
  1.  ;            = Chart Number(all numeric) - use FIND^DIC call W/ EXACT
  1.  ;                -  ^AUPNPAT("D",    - RETURNS EXACT FIND
  1.  ;            = SSN - (ALL numeric) - DPT("SSN" - use FIND^DIC call
  1.  ;                   - RETURNS EXACT FIND
  1.  ;            = LOC - dont know what to do right now. - DPT("CN"
  1.  ;    BGUGMAX = max number of records to send per call.
  1.  ;  ^DD("DD") = "S Y=$$FMTE^DILIBF(Y,""5U"")"  - disp day of week
  1.  ;
  1.  ;if SEARCH-KEY is 1-6 digits - search by Chart Number.
  1.  ;                   9 digits - search by SSN
  1.  ;                 1A4N       - search by A1N4
  1.  ;              contains "/", - search by DOB
  1.  ;ELSE                        - search by partial name.
  1.  ;OUTPUTS: RESULT() = NAME^DFN^DOB^SSN^HRCN^LOC
  1.  ;
  1.  K BGUDATA,RESULT
  1.  N BGUGCNT,BGUGDFN,BGUGZROS
  1.  S BGUGQT="""",RESULT(0.01)=0
  1.  ;
  1.  S BGUGROOT="^BGUTMP("_$J,BGUGTROT=BGUGROOT_")"
  1.  S BGUGMROT=BGUGROOT_","_BGUGQT_"ERRMSG"_BGUGQT_")"
  1.  K @BGUGTROT
  1.  ;
  1.  ;LIST - FIRST letter of last name and 4 digits of SSN:
  1.  I BGUGX?1A4N D A1N4 Q
  1.  ;
  1.  ;FIND - If BGUGX contains "/", this is DOB (so DOB input must contain "/").
  1.  I BGUGX["/" D DOB Q
  1.  ;
  1.  ;FIND - SSN - EXACT 9 digits.  ADD ;.09 would give SSN, but...
  1.  I BGUGX?9N D SSN Q
  1.  ;
  1.  ;FIND - Chart Number - EXACT 1-6 digits.   ^AUPNPAT("D",BGUGCHRT,DFN,FAC)
  1.  ;In SCREEN^DICL2(), DIENTRY = the curr. chart number, DIEN=DFN.
  1.  I BGUGX?1.6N D CHRT Q
  1.  ;
  1.  ;LIST - Assume PARTIAL NAME search
  1.  D LSTNM,KILL Q
  1.  ;
  1. A1N4 ;LIST BY A1N4
  1.  S BGUGFILE=2,BGUGINDX="BS5",BGUGFLDS=".01",X1=$E(BGUGX),X2=$E(BGUGX,2,5)+10000
  1.  S:X2'="10000" X2=X2-1,BGUGX=$E(BGUGX)_$E(X2,2,5)
  1.  S:X2=10000 X1=$C($A(X1)-1),BGUGX=X1_9999
  1.  S BGUGNX="S BGUGSTRT=$E(BGUGNM)_$E(BGUGSSN,1,4)"
  1.  D DICLST,FMTOUT,KILL
  1.  Q
  1.  ;
  1. DOB ;LOOK UP BY DOB- EXACT MATCH FIND
  1.  ;DOB is a regular field in 2.   DOB is a COMPUTED field in 9000001.
  1.  S BGUGFILE=2,BGUGINDX="ADOB",BGUGFLDS=".01"
  1.  S BGUGNX="S BGUGSTRT=DOB"
  1.  D DICFIND,FMTOUT,KILL
  1.  Q
  1.  ;
  1. SSN ;EXACT MATCH FIND
  1.  ;LIST- S X=1000000000+X-1,X=$E(X,2,10) D DICLST,FMTOUT,KILL Q
  1.  S BGUGFILE=2,BGUGINDX="SSN",BGUGFLDS=".01;.09"
  1.  S BGUGNX="S BGUGSTRT=BGUGSSN"
  1.  D DICFIND,FMTOUT,KILL
  1.  Q
  1.  ;
  1. CHRT ;EXACT MATCH FIND - 1 to 6 digits (No Leading zeros)
  1.  ;LIST^DIC- In SCREEN^DICL2(), DIENTRY=the curr. chart number, DIEN=DFN.
  1.  S BGUGSCRN="I $D(^AUPNPAT(""D"",DIVALUE,DIENTRY,DUZ(2)))"
  1.  S BGUGFILE=9000001,BGUGINDX="D",BGUGFLDS=".01"
  1.  S BGUGNX="S BGUGSTRT=CHRT"
  1.  D DICFIND,FMTOUT,KILL
  1.  Q
  1.  ;
  1. DICLST ;SETUP to call LIST^DIC( ) - BGUGSCRN code is executed in ^DIL2C
  1.  S BGUGIEN="",BGUGFLGS=""
  1.  S BGUGNUM=BGUGMAX+1,BGUGFROM=BGUGX
  1.  S BGUGPART="",BGUGIDFR="",BGUGSCRN=$G(BGUGSCRN)
  1.  D LIST^DIC(BGUGFILE,BGUGIEN,BGUGFLDS,BGUGFLGS,BGUGNUM,BGUGFROM,BGUGPART,BGUGINDX,BGUGSCRN,BGUGIDFR,BGUGTROT)
  1.  Q
  1.  ;
  1. DICFIND ;SETUP to call FIND^DIC() - BGUGSCRN code is executed in ^DICF3
  1.  S BGUGIEN="",BGUGFLGS=""
  1.  S BGUGNUM=BGUGMAX+1,BGUGVAL=BGUGX
  1.  S BGUGIDFR="",BGUGSCRN=$G(BGUGSCRN)
  1.  D FIND^DIC(BGUGFILE,BGUGIEN,BGUGFLDS,BGUGFLGS,BGUGVAL,BGUGNUM,BGUGINDX,BGUGSCRN,BGUGIDFR,BGUGTROT,BGUGMROT)
  1.  Q
  1.  ;
  1. FMTOUT ;FMT output
  1.  N BGUGCHRT,BGUGDFN,BGUGGLB,I,BGUGNM,BGUGOUT,BGUGSSN
  1.  S BGUGGLB=BGUGROOT_","_BGUGQT_"DILIST"_BGUGQT_")",BGUGOUT="RESULT",BGUGCTR=0
  1.  S I=0 F  S I=$O(@BGUGGLB@(2,I)) Q:I=""  D
  1.  . S BGUGDFN=@BGUGGLB@(2,I),BGUGNM=@BGUGGLB@("ID",I,".01")
  1.  . S BGUGVAL=^DPT(BGUGDFN,0),BGUSEX=$P(BGUGVAL,U,2),Y=$P(BGUGVAL,U,3) X ^DD("DD")
  1.  . S BGUGSSN=$P(BGUGVAL,U,9)
  1.  . S BGUGHRCN=$P($G(^AUPNPAT(BGUGDFN,41,DUZ(2),0)),U,2)
  1.  . S BGUGGLOC=$P($G(^DPT(BGUGDFN,.1)),U,1),BGUGGLOC=$S(BGUGGLOC="":"OP",1:BGUGGLOC)
  1.  . S BGUGCTR=BGUGCTR+1,@BGUGOUT@(BGUGCTR)=BGUGNM_U_BGUGDFN_U_Y_U_BGUGSSN_U_BGUGHRCN_U_BGUGGLOC_U_BGUSEX
  1.  S @BGUGOUT@(0.01)=BGUGCTR
  1.  S BGUGSTRT=""
  1.  I BGUGCTR>BGUGMAX X $G(BGUGNX) S @BGUGOUT@(BGUGMAX+1)="..MORE^"_BGUGSTRT_"|"_BGUGDFN
  1.  E  S @BGUGOUT@(BGUGCTR+1)="**END**"
  1.  Q
  1.  ;
  1. LSTNM ;Partial last name search
  1.  S %=$S($L(BGUGMORE):$O(^DPT("B",$P(BGUGMORE,"|",1)),-1),1:$O(^DPT("B",BGUGX),-1))
  1.  S BGUGCNT=0
  1.  S BGUGDFN=$P(BGUGMORE,"|",2) S BGUGDFN=+BGUGDFN,BGUGDFN=BGUGDFN-1
  1.  S BGUGGL=$L(BGUGX)
  1.  ;
  1.  F  S %=$O(^DPT("B",%)) Q:%=""!($E(%,1,BGUGGL)'=BGUGX)  D  Q:BGUGCNT=BGUGMAX
  1.  . F  S BGUGDFN=$O(^DPT("B",%,BGUGDFN)) Q:'BGUGDFN!(BGUGCNT=BGUGMAX)  D:$G(^DPT(BGUGDFN,0))'="" LSTNMA
  1.  I BGUGCNT=BGUGMAX&($L(%)),$E(%,1,BGUGGL)=BGUGX D
  1.  . S:$L(BGUGDFN) BGUGCNT=BGUGCNT+1,RESULT(BGUGCNT)="..MORE^"_%_"|"_BGUGDFN
  1.  . S:'$L(BGUGDFN) %=$O(^DPT("B",%)),BGUGDFN=$O(^DPT("B",%,BGUGDFN)) S BGUGCNT=BGUGCNT+1,RESULT(BGUGCNT)="..MORE^"_%_"|"_BGUGDFN
  1.  ;S:$E(%,1,BGUGGL)'=BGUGX BGUGCNT=BGUGCNT+1,RESULT(BGUGCNT)="**END**"
  1.  S RESULT(0.01)=BGUGCNT
  1.  Q
  1. LSTNMA ;
  1.  S BGUGVAL=^DPT(BGUGDFN,0),BGUSEX=$P(BGUGVAL,U,2),Y=$P(BGUGVAL,U,3) X ^DD("DD")
  1.  S BGUGCNT=BGUGCNT+1
  1.  S RESULT(BGUGCNT)=%_U_BGUGDFN_U_Y_U_$P(BGUGVAL,"^",9)_U_$P($G(^AUPNPAT(BGUGDFN,41,DUZ(2),0)),U,2)
  1.  S BGUGGLOC=$P($G(^DPT(BGUGDFN,.1)),U,1)
  1.  S RESULT(BGUGCNT)=RESULT(BGUGCNT)_U_$S(BGUGGLOC="":"OP",1:BGUGGLOC)
  1.  S RESULT(BGUGCNT)=RESULT(BGUGCNT)_U_BGUSEX
  1.  Q
  1.  ;
  1. KILL ;
  1.  K %,BGUAGEG,BGUBYR,BGUGCNT,BGUD,BGUGDFN,BGUEYR,BGUINC,BGUJ,BGUGMAX
  1.  K BGUOBJ,BGUOBJN,BGUOBJV,BGUPARM,BGUGQTR,BGURTN,BGUYQ,BGUYR
  1.  K BGUGCTR,BGUGFLDS,BGUGFILE,BGUGFLGS,BGUGFROM,BGUGGLB
  1.  K BGUGIDFR,BGUGIEN,BGUGINDX,BGUGGL,BGUGZROS,BGUGVAL,BGUGSSN
  1.  K BGUGNM,BGUGNUM,BGUGOUT,BGUGPART,BGUGQT,BGUGROOT,BGUGSCRN,BGUGTROT,BGUSEX
  1.  K X1,X2,I
  1.  Q