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

DPTLK5.m

Go to the documentation of this file.
  1. DPTLK5 ;BAY/JAT,EG - Patient lookup APIs for patient safety issues ; 11 Aug 2005 8:20 AM
  1. ;;5.3;Registration;**265,276,277,485,675,788**;Aug 13, 1993;Build 18
  1. Q
  1. BS5(DPTDFN) ;function checks if other patients on "BS5" xref
  1. ; with same last name
  1. ; returns 1 if other patients exist
  1. ; input: ien of Patient file
  1. I '$G(DPTDFN) Q 0
  1. I '$D(^DPT(DPTDFN,0)) Q 0
  1. N DPT0,DPTNME,DPTSSN,DPTBS5,DPTLAST,DPTIEN,DPTFLAG
  1. S DPT0=^DPT(DPTDFN,0)
  1. S DPTNME=$E(DPT0,1),DPTSSN=$E($P(DPT0,U,9),6,9)
  1. S DPTBS5=DPTNME_DPTSSN
  1. S DPTLAST=$P($P(DPT0,U),",")
  1. S (DPTIEN,DPTFLAG)=0
  1. F S DPTIEN=$O(^DPT("BS5",DPTBS5,DPTIEN)) Q:'DPTIEN!(DPTFLAG=1) D
  1. .Q:DPTDFN=DPTIEN
  1. .S DPTNME=$P($P($G(^DPT(DPTIEN,0)),U),",")
  1. .I DPTNME=DPTLAST S DPTFLAG=1
  1. Q DPTFLAG
  1. ;
  1. DMT(DPTDFN,DPTUSER) ; function checks if the 'Display Means Test Required'
  1. ; message is to be displayed for this Division
  1. ; returns Division ien if message is to be displayed
  1. ; input: a) ien of Patient file
  1. ; b) user's Institution for current session (DUZ(2))
  1. ; DD(200.02,.01)<==>DD(4,DINUM)<==>DD(40.8,.07)
  1. I '$G(DPTDFN)!('$G(DPTUSER)) Q 0
  1. N Y,DFN,DGREQF,DGMTLST,DPTDIV
  1. ; verifies that Means Test required for this patient
  1. ;
  1. S DFN=DPTDFN
  1. S DGMTLST=$$CMTS^DGMTU(DFN)
  1. ;only display division message if means test is required
  1. I '$$MFLG^DGMTU(DGMTLST) Q 0
  1. S DPTDIV=0
  1. S DPTDIV=$O(^DG(40.8,"AD",DPTUSER,DPTDIV))
  1. I DPTDIV,$P($G(^DG(40.8,DPTDIV,"MT")),U)="Y" Q DPTDIV
  1. Q 0
  1. ;
  1. FFP ; This function checks if the 'Display Fugitive Felon Message'
  1. ; message is to be displayed. Message displays only for DG and SD
  1. ; menu options
  1. ;
  1. Q:'$D(XQY0)
  1. Q:$E(XQY0,1,2)'="SD"&($E(XQY0,1,2)'="DG")
  1. ;
  1. N X,Y,IORVON,IORVOFF,DIR,DIRUT
  1. S X="IORVON;IORVOFF"
  1. D ENDR^%ZISS
  1. W !?17,$CHAR(7) W:$D(IORVON) IORVON W "*** WARNING - FFP FLAG ACTIVE ***" W:$D(IORVOFF) IORVOFF
  1. W !?19,$CHAR(7) W:$D(IORVON) IORVON W "PLEASE NOTIFY YOUR SUPERVISOR" W:$D(IORVOFF) IORVOFF
  1. W !
  1. I '$D(DGCLIST) D
  1. . S DIR(0)="FAO",DIR("A")="Enter <RETURN> to continue."
  1. . D ^DIR K DIR
  1. Q