- 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 Jan 18, 2025@04:01:38 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