1 | DPTLK5 ;BAY/JAT,EG - Patient lookup APIs for patient safety issues ; 11 Aug 2005 8:20 AM
|
---|
2 | ;;5.3;Registration;**265,276,277,485,675**;Aug 13, 1993
|
---|
3 | Q
|
---|
4 | BS5(DPTDFN) ;function checks if other patients on "BS5" xref
|
---|
5 | ; with same last name
|
---|
6 | ; returns 1 if other patients exist
|
---|
7 | ; input: ien of Patient file
|
---|
8 | I '$G(DPTDFN) Q 0
|
---|
9 | I '$D(^DPT(DPTDFN,0)) Q 0
|
---|
10 | N DPT0,DPTNME,DPTSSN,DPTBS5,DPTLAST,DPTIEN,DPTFLAG
|
---|
11 | S DPT0=^DPT(DPTDFN,0)
|
---|
12 | S DPTNME=$E(DPT0,1),DPTSSN=$E($P(DPT0,U,9),6,9)
|
---|
13 | S DPTBS5=DPTNME_DPTSSN
|
---|
14 | S DPTLAST=$P($P(DPT0,U),",")
|
---|
15 | S (DPTIEN,DPTFLAG)=0
|
---|
16 | F S DPTIEN=$O(^DPT("BS5",DPTBS5,DPTIEN)) Q:'DPTIEN!(DPTFLAG=1) D
|
---|
17 | .Q:DPTDFN=DPTIEN
|
---|
18 | .S DPTNME=$P($P($G(^DPT(DPTIEN,0)),U),",")
|
---|
19 | .I DPTNME=DPTLAST S DPTFLAG=1
|
---|
20 | Q DPTFLAG
|
---|
21 | ;
|
---|
22 | DMT(DPTDFN,DPTUSER) ; function checks if the 'Display Means Test Required'
|
---|
23 | ; message is to be displayed for this Division
|
---|
24 | ; returns Division ien if message is to be displayed
|
---|
25 | ; input: a) ien of Patient file
|
---|
26 | ; b) user's Institution for current session (DUZ(2))
|
---|
27 | ; DD(200.02,.01)<==>DD(4,DINUM)<==>DD(40.8,.07)
|
---|
28 | I '$G(DPTDFN)!('$G(DPTUSER)) Q 0
|
---|
29 | N Y,DFN,DGREQF,DGMTLST,DPTDIV
|
---|
30 | ; verifies that Means Test required for this patient
|
---|
31 | ;
|
---|
32 | S DFN=DPTDFN
|
---|
33 | S DGMTLST=$$CMTS^DGMTU(DFN)
|
---|
34 | ;only display division message if means test is required
|
---|
35 | I '$$MFLG^DGMTU(DGMTLST) Q 0
|
---|
36 | S DPTDIV=0
|
---|
37 | S DPTDIV=$O(^DG(40.8,"AD",DPTUSER,DPTDIV))
|
---|
38 | I DPTDIV,$P($G(^DG(40.8,DPTDIV,"MT")),U)="Y" Q DPTDIV
|
---|
39 | Q 0
|
---|
40 | ;
|
---|
41 | FFP ; This function checks if the 'Display Fugitive Felon Message'
|
---|
42 | ; message is to be displayed. Message displays only for DG and SD
|
---|
43 | ; menu options
|
---|
44 | ;
|
---|
45 | Q:'$D(XQY0)
|
---|
46 | Q:$E(XQY0,1,2)'="SD"&($E(XQY0,1,2)'="DG")
|
---|
47 | ;
|
---|
48 | N X,Y,IORVON,IORVOFF,DIR,DIRUT
|
---|
49 | S X="IORVON;IORVOFF"
|
---|
50 | D ENDR^%ZISS
|
---|
51 | W !?17,$CHAR(7) W:$D(IORVON) IORVON W "*** WARNING - FFP FLAG ACTIVE ***" W:$D(IORVOFF) IORVOFF
|
---|
52 | W !?19,$CHAR(7) W:$D(IORVON) IORVON W "PLEASE NOTIFY YOUR SUPERVISOR" W:$D(IORVOFF) IORVOFF
|
---|
53 | W !
|
---|
54 | S DIR(0)="FAO",DIR("A")="Enter <RETURN> to continue."
|
---|
55 | D ^DIR K DIR
|
---|
56 | Q
|
---|