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