DGPFRDB.m

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 ---DGPFRDB   2882     printed  Apr 09, 2024@22:02:31                                                                                                                                                                                                     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      ;_______________________________________________________________________________