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

DPTLK6.m

Go to the documentation of this file.
  1. DPTLK6 ;BAY/JAT,EG - Patient lookup RPCs for patient safety issue ; 11 Aug 2005 8:33 AM
  1. ;;5.3;Registration;**265,276,277,675**;Aug 13, 1993
  1. GUIBS5(GUIDATA,DFN) ; RPC checks if other patients on "BS5" xref
  1. ; with same last name
  1. ; returns: 1 or 0 (or -1 if bad dfn or no zero node)
  1. ; if 1, returns text to be displayed
  1. ; return type: array
  1. ; parameter: ien of Patient file
  1. K GUIDATA
  1. I '$G(DFN) S GUIDATA(1)=-1 Q
  1. I '$D(^DPT(DFN,0)) S GUIDATA(1)=-1 Q
  1. I '$$BS5^DPTLK5(DFN) S GUIDATA(1)=0 Q
  1. S GUIDATA(1)=1
  1. N DPT0,DPTNME,DPTSSN
  1. S DPT0=$G(^DPT(DFN,0))
  1. S DPTNME=$P($P(DPT0,U),",")
  1. S DPTSSN=$E($P(DPT0,U,9),6,9)
  1. S GUIDATA(2)="There is more than one patient whose last name is "_DPTNME
  1. S GUIDATA(3)="and whose social security number ends with "_DPTSSN
  1. S GUIDATA(4)="Are you sure you wish to continue?"
  1. Q
  1. ;
  1. GUIBS5A(GUIDATA,DFN) ; RPC checks if other patients on "BS5" xref
  1. ; with same last name
  1. ; returns 1 or 0 in 1st string (or -1 if bad DFN or no zero node)
  1. ; if 1 returns array nodes where
  1. ; text is preceeded by 0 (0^<text>)
  1. ; and patient data is preceeded by 1 (1^DFN^patient name^DOB^SSN)
  1. ; return type: global array
  1. ; parameter: ien of Patient file
  1. K GUIDATA
  1. I '$G(DFN) S GUIDATA(1)=-1 Q
  1. I '$D(^DPT(DFN,0)) S GUIDATA(1)=-1 Q
  1. I '$$BS5^DPTLK5(DFN) S GUIDATA(1)=0 Q
  1. K ^TMP("DPTLK6",$J)
  1. S ^TMP("DPTLK6",$J,1)=1
  1. N DPT0,DPTNME,DPTSSN,DPTBS5,DPTLAST,DPTIEN,DPTCNT,DPTDOB,DPTSSN1
  1. S DPT0=^DPT(DFN,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 ^TMP("DPTLK6",$J,2)="0^There is more than one patient whose last name is "_DPTLAST
  1. S ^TMP("DPTLK6",$J,3)="0^and whose social security number ends with "_DPTSSN
  1. S DPTCNT=3
  1. S DPTIEN=0
  1. F S DPTIEN=$O(^DPT("BS5",DPTBS5,DPTIEN)) Q:'DPTIEN D
  1. .S DPT0=$G(^DPT(DPTIEN,0)),DPTNME=$P($P(DPT0,U),",")
  1. .Q:DPTNME'=DPTLAST
  1. .S DPTNME=$P(DPT0,U)
  1. .I $T(DOB^DPTLK1)'="" S DPTDOB=$$DOB^DPTLK1(DPTIEN,2),DPTSSN1=$$SSN^DPTLK1(DPTIEN)
  1. .E S DPTDOB=$P(DPT0,U,3),DPTSSN1=$P(DPT0,U,9)
  1. .S DPTCNT=DPTCNT+1
  1. .S ^TMP("DPTLK6",$J,DPTCNT)="1"_U_DPTIEN_U_DPTNME_U_DPTDOB_U_DPTSSN1
  1. S DPTCNT=DPTCNT+1
  1. S ^TMP("DPTLK6",$J,DPTCNT)="0^Are you sure you wish to continue?"
  1. M GUIDATA=^TMP("DPTLK6",$J)
  1. K ^TMP("DPTLK6",$J)
  1. Q
  1. ;
  1. GUIDMT(GUIDATA,DUZ2) ; RPC checks if the 'Display Means Test Required'
  1. ; message is to be displayed for the Division user is in
  1. ; returns 1 or 0 in 1st string (or -1 if bad DUZ(2))
  1. ; if 1, returns text to be displayed in 2nd and 3rd string (if any)
  1. ; return type: array
  1. ; parameter: Institution file pointer for user (optional)
  1. K GUIDATA
  1. I '$G(DUZ2) S DUZ2=DUZ(2)
  1. I '$G(DUZ2) S GUIDATA(1)=-1 Q
  1. N DPTDIV,DPTDIVMT S DPTDIV=0
  1. S DPTDIV=$O(^DG(40.8,"AD",DUZ2,DPTDIV))
  1. I '$G(DPTDIV) S GUIDATA(1)=-1 Q
  1. S GUIDATA(1)=0
  1. S DPTDIVMT=$G(^DG(40.8,DPTDIV,"MT"))
  1. I $P(DPTDIVMT,U,3)="Y" S GUIDATA(1)=1,GUIDATA(2)="MEANS TEST REQUIRED",GUIDATA(3)=$P(DPTDIVMT,U,2)
  1. Q
  1. ;
  1. GUIMT(GUIDATA,DFN) ; RPC checks if Means Test is required for this patient
  1. ; returns 1 or 0 (or -1 if bad DFN)
  1. ; return type: single value
  1. ; parameter: ien of Patient file
  1. K GUIDATA
  1. I '$G(DFN) S GUIDATA=-1 Q
  1. N Y,DGREQF,DGMTLST
  1. S GUIDATA=0
  1. S DGMTLST=$$CMTS^DGMTU(DFN)
  1. I $P(DGMTLST,U,4)'="R" Q
  1. S GUIDATA=1
  1. Q
  1. ;
  1. GUIMTD(GUIDATA,DFN,DUZ2) ; RPC checks if Means Test is required for this
  1. ; patient and if 'Means Test Required' message is to be
  1. ; displayed for the Division user is in
  1. ; returns 1 or 0 in 1st string (or -1 if bad parameters)
  1. ; if 1, returns text to be displayed in 2nd and 3rd string (if any)
  1. ; return type: array
  1. ; parameters: ien of Patient file, Institution file pointer for user
  1. ; (optional)
  1. K GUIDATA
  1. I '$G(DUZ2) S DUZ2=DUZ(2)
  1. I '$G(DFN)!('$G(DUZ2)) S GUIDATA(1)=-1 Q
  1. N DPTDIV,DPTDIVMT S DPTDIV=0
  1. S DPTDIV=$O(^DG(40.8,"AD",DUZ2,DPTDIV))
  1. I '$G(DPTDIV) S GUIDATA(1)=-1 Q
  1. N Y,DGREQF,DGMTLST
  1. S GUIDATA(1)=0
  1. S DGMTLST=$$CMTS^DGMTU(DFN)
  1. ;only display division message if means test is required
  1. I '$$MFLG^DGMTU(DGMTLST) Q
  1. S DPTDIVMT=$G(^DG(40.8,DPTDIV,"MT"))
  1. I $P(DPTDIVMT,U,3)="Y" S GUIDATA(1)=1,GUIDATA(2)="MEANS TEST REQUIRED",GUIDATA(3)=$P(DPTDIVMT,U,2)
  1. Q
  1. ;