[613] | 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
|
---|