DPTLK5 ;BAY/JAT,EG - Patient lookup APIs for patient safety issues ; 11 Aug 2005 8:20 AM
;;5.3;Registration;**265,276,277,485,675,788**;Aug 13, 1993;Build 18
Q
BS5(DPTDFN) ;function checks if other patients on "BS5" xref
; with same last name
; returns 1 if other patients exist
; input: ien of Patient file
I '$G(DPTDFN) Q 0
I '$D(^DPT(DPTDFN,0)) Q 0
N DPT0,DPTNME,DPTSSN,DPTBS5,DPTLAST,DPTIEN,DPTFLAG
S DPT0=^DPT(DPTDFN,0)
S DPTNME=$E(DPT0,1),DPTSSN=$E($P(DPT0,U,9),6,9)
S DPTBS5=DPTNME_DPTSSN
S DPTLAST=$P($P(DPT0,U),",")
S (DPTIEN,DPTFLAG)=0
F S DPTIEN=$O(^DPT("BS5",DPTBS5,DPTIEN)) Q:'DPTIEN!(DPTFLAG=1) D
.Q:DPTDFN=DPTIEN
.S DPTNME=$P($P($G(^DPT(DPTIEN,0)),U),",")
.I DPTNME=DPTLAST S DPTFLAG=1
Q DPTFLAG
;
DMT(DPTDFN,DPTUSER) ; function checks if the 'Display Means Test Required'
; message is to be displayed for this Division
; returns Division ien if message is to be displayed
; input: a) ien of Patient file
; b) user's Institution for current session (DUZ(2))
; DD(200.02,.01)<==>DD(4,DINUM)<==>DD(40.8,.07)
I '$G(DPTDFN)!('$G(DPTUSER)) Q 0
N Y,DFN,DGREQF,DGMTLST,DPTDIV
; verifies that Means Test required for this patient
;
S DFN=DPTDFN
S DGMTLST=$$CMTS^DGMTU(DFN)
;only display division message if means test is required
I '$$MFLG^DGMTU(DGMTLST) Q 0
S DPTDIV=0
S DPTDIV=$O(^DG(40.8,"AD",DPTUSER,DPTDIV))
I DPTDIV,$P($G(^DG(40.8,DPTDIV,"MT")),U)="Y" Q DPTDIV
Q 0
;
FFP ; This function checks if the 'Display Fugitive Felon Message'
; message is to be displayed. Message displays only for DG and SD
; menu options
;
Q:'$D(XQY0)
Q:$E(XQY0,1,2)'="SD"&($E(XQY0,1,2)'="DG")
;
N X,Y,IORVON,IORVOFF,DIR,DIRUT
S X="IORVON;IORVOFF"
D ENDR^%ZISS
W !?17,$CHAR(7) W:$D(IORVON) IORVON W "*** WARNING - FFP FLAG ACTIVE ***" W:$D(IORVOFF) IORVOFF
W !?19,$CHAR(7) W:$D(IORVON) IORVON W "PLEASE NOTIFY YOUR SUPERVISOR" W:$D(IORVOFF) IORVOFF
W !
I '$D(DGCLIST) D
. S DIR(0)="FAO",DIR("A")="Enter <RETURN> to continue."
. D ^DIR K DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDPTLK5 2068 printed Sep 23, 2025@20:36:51 Page 2
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
+2 QUIT
BS5(DPTDFN) ;function checks if other patients on "BS5" xref
+1 ; with same last name
+2 ; returns 1 if other patients exist
+3 ; input: ien of Patient file
+4 IF '$GET(DPTDFN)
QUIT 0
+5 IF '$DATA(^DPT(DPTDFN,0))
QUIT 0
+6 NEW DPT0,DPTNME,DPTSSN,DPTBS5,DPTLAST,DPTIEN,DPTFLAG
+7 SET DPT0=^DPT(DPTDFN,0)
+8 SET DPTNME=$EXTRACT(DPT0,1)
SET DPTSSN=$EXTRACT($PIECE(DPT0,U,9),6,9)
+9 SET DPTBS5=DPTNME_DPTSSN
+10 SET DPTLAST=$PIECE($PIECE(DPT0,U),",")
+11 SET (DPTIEN,DPTFLAG)=0
+12 FOR
SET DPTIEN=$ORDER(^DPT("BS5",DPTBS5,DPTIEN))
if 'DPTIEN!(DPTFLAG=1)
QUIT
Begin DoDot:1
+13 if DPTDFN=DPTIEN
QUIT
+14 SET DPTNME=$PIECE($PIECE($GET(^DPT(DPTIEN,0)),U),",")
+15 IF DPTNME=DPTLAST
SET DPTFLAG=1
End DoDot:1
+16 QUIT DPTFLAG
+17 ;
DMT(DPTDFN,DPTUSER) ; function checks if the 'Display Means Test Required'
+1 ; message is to be displayed for this Division
+2 ; returns Division ien if message is to be displayed
+3 ; input: a) ien of Patient file
+4 ; b) user's Institution for current session (DUZ(2))
+5 ; DD(200.02,.01)<==>DD(4,DINUM)<==>DD(40.8,.07)
+6 IF '$GET(DPTDFN)!('$GET(DPTUSER))
QUIT 0
+7 NEW Y,DFN,DGREQF,DGMTLST,DPTDIV
+8 ; verifies that Means Test required for this patient
+9 ;
+10 SET DFN=DPTDFN
+11 SET DGMTLST=$$CMTS^DGMTU(DFN)
+12 ;only display division message if means test is required
+13 IF '$$MFLG^DGMTU(DGMTLST)
QUIT 0
+14 SET DPTDIV=0
+15 SET DPTDIV=$ORDER(^DG(40.8,"AD",DPTUSER,DPTDIV))
+16 IF DPTDIV
IF $PIECE($GET(^DG(40.8,DPTDIV,"MT")),U)="Y"
QUIT DPTDIV
+17 QUIT 0
+18 ;
FFP ; This function checks if the 'Display Fugitive Felon Message'
+1 ; message is to be displayed. Message displays only for DG and SD
+2 ; menu options
+3 ;
+4 if '$DATA(XQY0)
QUIT
+5 if $EXTRACT(XQY0,1,2)'="SD"&($EXTRACT(XQY0,1,2)'="DG")
QUIT
+6 ;
+7 NEW X,Y,IORVON,IORVOFF,DIR,DIRUT
+8 SET X="IORVON;IORVOFF"
+9 DO ENDR^%ZISS
+10 WRITE !?17,$CHAR(7)
if $DATA(IORVON)
WRITE IORVON
WRITE "*** WARNING - FFP FLAG ACTIVE ***"
if $DATA(IORVOFF)
WRITE IORVOFF
+11 WRITE !?19,$CHAR(7)
if $DATA(IORVON)
WRITE IORVON
WRITE "PLEASE NOTIFY YOUR SUPERVISOR"
if $DATA(IORVOFF)
WRITE IORVOFF
+12 WRITE !
+13 IF '$DATA(DGCLIST)
Begin DoDot:1
+14 SET DIR(0)="FAO"
SET DIR("A")="Enter <RETURN> to continue."
+15 DO ^DIR
KILL DIR
End DoDot:1
+16 QUIT
