source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DPTLK5.m@ 1688

Last change on this file since 1688 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1DPTLK5 ;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
4BS5(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 ;
22DMT(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 ;
41FFP ; 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
Note: See TracBrowser for help on using the repository browser.