DGPFRDB ;SHRPE/SGM - DBRS HISTORY REPORT ; Aug 07, 2018 09:45
;;5.3;Registration;**951**;Aug 13, 1993;Build 135
; Last Edited: SHRPE/SGM - Aug 17,2018 10:16
;
; ICR# TYPE DESCRIIPTION
;----- ---- ----------------------------
; 1519 Sup EN^XUTMDEVQ
;10006 Sup ^DIC
;10086 Sup HOME^%ZIS
; Sup $$FMTE^XLFDT
;
QUIT
;
; 1. Select one Category I Behavioral flag assignment
; 2. Enter starting and ending dates. These dates will be checked
; against the DATE/TIME field in file 26.14
;
EN ;Entry point
N X,Y,DGSRC,ZTSAVE,ZTREQ,ZTSK
;
;--- select a patient, behavioral flag assignment
S X=$$SELASGN^DGPFUT6("BEH","Z") Q:X<1
S DGSRC("ASGN")=+X
S DGSRC("DFN")=$P(X,U,2)
;
;--- select beginning date
W ! S X=$$DATEBEG Q:X<1
;
;--- select end date
Q:$$DATEEND<1
;
;--- prompt for device
S ZTSAVE("DGSRC(")=""
S X="PRF DBRS Numbers Report"
D EN^XUTMDEVQ("START^DGPFRDB1",X,.ZTSAVE)
D HOME^%ZIS
Q
;
;------------------------ PRIVATE SUBROUTINES ------------------------
;
DATEBEG() ;-- prompt for beginning date
N X,Y,DGDIRA,DGDIRB
S DGDIRA="Select Beginning Date"
S DGDIRB=""
S DGDIRO="DO"
S X=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO)
I X>0 S DGSRC("BEG")=X
Q X>0
;
DATEEND() ;-- prompt for ending date
N X,Y,DGDIRA,DGDIRB,DGDIRO
S Y=$$FMTE(DGSRC("BEG"))_" - "_$$FMTE(DT)
S DGDIRA="Select Ending Date ("_Y_"): "
S DGDIRB=$$FMTE(DT,"1Z")
S DGDIRO="DOA^"_DGSRC("BEG")_":DT:EX"
S X=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO)
I X>0 S DGSRC("END")=X
Q X>0
;
FMTE(DATE,FMT) ;
S:$G(FMT)="" FMT="2Z"
Q $$FMTE^XLFDT(DATE,FMT)
;
; **** REPORT FORMAT ****
; 1 2 3 4 5 6 7 8
;12345678901234567890123456789012345678901234567890123456789012345678901234567890
;BEHAVIORAL PRF DISRUPTIVE BEHAVIOR DATA REPORT Page: 1
;Patient: [-----patient name-----------] (6890) Dates: 01/01/18 - 03/09/18
;================================================================================
;
; DBRS Number Date DBRS Other Information
;------------------ -------- --------------------------------------------------
;294AC Batavia NY VAMC 03/07/18 Rupert, Connie
;------------------ -------- --------------------------------------------------
;294AC.484744 03/07/18 Secondary DBRS Case opened for Patient.
;345.484744 03/07/18 Patient threatened clinician at outpatient appointm
; ent. DBRS case opened.
;673AA.180320 02/12/18 Patient admitted and was belligerent and said he wou
; Ld like to talk with doctor.
;673AB.180310 02/12/18 Patient first came to 673AB
;_______________________________________________________________________________
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFRDB 2882 printed Sep 23, 2025@20:24:29 Page 2
DGPFRDB ;SHRPE/SGM - DBRS HISTORY REPORT ; Aug 07, 2018 09:45
+1 ;;5.3;Registration;**951**;Aug 13, 1993;Build 135
+2 ; Last Edited: SHRPE/SGM - Aug 17,2018 10:16
+3 ;
+4 ; ICR# TYPE DESCRIIPTION
+5 ;----- ---- ----------------------------
+6 ; 1519 Sup EN^XUTMDEVQ
+7 ;10006 Sup ^DIC
+8 ;10086 Sup HOME^%ZIS
+9 ; Sup $$FMTE^XLFDT
+10 ;
+11 QUIT
+12 ;
+13 ; 1. Select one Category I Behavioral flag assignment
+14 ; 2. Enter starting and ending dates. These dates will be checked
+15 ; against the DATE/TIME field in file 26.14
+16 ;
EN ;Entry point
+1 NEW X,Y,DGSRC,ZTSAVE,ZTREQ,ZTSK
+2 ;
+3 ;--- select a patient, behavioral flag assignment
+4 SET X=$$SELASGN^DGPFUT6("BEH","Z")
if X<1
QUIT
+5 SET DGSRC("ASGN")=+X
+6 SET DGSRC("DFN")=$PIECE(X,U,2)
+7 ;
+8 ;--- select beginning date
+9 WRITE !
SET X=$$DATEBEG
if X<1
QUIT
+10 ;
+11 ;--- select end date
+12 if $$DATEEND<1
QUIT
+13 ;
+14 ;--- prompt for device
+15 SET ZTSAVE("DGSRC(")=""
+16 SET X="PRF DBRS Numbers Report"
+17 DO EN^XUTMDEVQ("START^DGPFRDB1",X,.ZTSAVE)
+18 DO HOME^%ZIS
+19 QUIT
+20 ;
+21 ;------------------------ PRIVATE SUBROUTINES ------------------------
+22 ;
DATEBEG() ;-- prompt for beginning date
+1 NEW X,Y,DGDIRA,DGDIRB
+2 SET DGDIRA="Select Beginning Date"
+3 SET DGDIRB=""
+4 SET DGDIRO="DO"
+5 SET X=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO)
+6 IF X>0
SET DGSRC("BEG")=X
+7 QUIT X>0
+8 ;
DATEEND() ;-- prompt for ending date
+1 NEW X,Y,DGDIRA,DGDIRB,DGDIRO
+2 SET Y=$$FMTE(DGSRC("BEG"))_" - "_$$FMTE(DT)
+3 SET DGDIRA="Select Ending Date ("_Y_"): "
+4 SET DGDIRB=$$FMTE(DT,"1Z")
+5 SET DGDIRO="DOA^"_DGSRC("BEG")_":DT:EX"
+6 SET X=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO)
+7 IF X>0
SET DGSRC("END")=X
+8 QUIT X>0
+9 ;
FMTE(DATE,FMT) ;
+1 if $GET(FMT)=""
SET FMT="2Z"
+2 QUIT $$FMTE^XLFDT(DATE,FMT)
+3 ;
+4 ; **** REPORT FORMAT ****
+5 ; 1 2 3 4 5 6 7 8
+6 ;12345678901234567890123456789012345678901234567890123456789012345678901234567890
+7 ;BEHAVIORAL PRF DISRUPTIVE BEHAVIOR DATA REPORT Page: 1
+8 ;Patient: [-----patient name-----------] (6890) Dates: 01/01/18 - 03/09/18
+9 ;================================================================================
+10 ;
+11 ; DBRS Number Date DBRS Other Information
+12 ;------------------ -------- --------------------------------------------------
+13 ;294AC Batavia NY VAMC 03/07/18 Rupert, Connie
+14 ;------------------ -------- --------------------------------------------------
+15 ;294AC.484744 03/07/18 Secondary DBRS Case opened for Patient.
+16 ;345.484744 03/07/18 Patient threatened clinician at outpatient appointm
+17 ; ent. DBRS case opened.
+18 ;673AA.180320 02/12/18 Patient admitted and was belligerent and said he wou
+19 ; Ld like to talk with doctor.
+20 ;673AB.180310 02/12/18 Patient first came to 673AB
+21 ;_______________________________________________________________________________
