DGPFRAL ;ALB/RBS - PRF ACTION NOT LINKED REPORT ; 7/26/05 3:18pm
;;5.3;Registration;**554,960**;Aug 13, 1993;Build 22
; Last Edited: SHRPE/SGM - Jun 29,2018 15:14
;
; ICR# TYPE DESCRIIPTION
;----- ---- ----------------------------
; 1519 Sup EN^XUTMDEVQ
;10006 Sup ^DIC
;10086 Sup HOME^%ZIS
;
;This routine will be used for selecting sort parameters to produce
;the DGPF ACTION NOT LINKED REPORT for Patient Record Flags.
;
; Selection options will provide the ability to report by:
; CATEGORY
; BEGINNING DATE
; ENDING DATE
;
; The following reporting sort array will be built by user prompts:
; DGSORT("DGCAT") = 1^Category I (National)
; 2^Category II (Local)
; 3^Both
; DGSORT("DGBEG") = BEGINNING DATE (internal FileMan date)
; DGSORT("DGEND") = ENDING DATE (internal FileMan date)
; DGSORT("DGFAC") = 1^Local Facility Only
; 2^Other Facilities
; 3^Both
; DGSORT("DGFLG") = "" for all flags
; Else pointer^name^variable_pointer
; DGSORT("DGSTA") = 0^Inactive
; 1^Active
; 2^Both
;
;-- no direct entry
QUIT
;
EN ;Entry point
;-- user prompts for report selection sorts
; DG*5.3*960 - $$FLAGONE, $$STATUS, $$TYPE
; Input: none
; Output: Report generated using user selected parameters
;
N DGFIRST ;first assignment date
N DGSEL ;help text var
N DGSORT ;array or report parameters
N ZTSAVE ;open array reference of input parameters used by tasking
N X,Y
;
S DGFIRST=$P(+$O(^DGPF(26.14,"D","")),".") ;first assignment date
I 'DGFIRST D Q
. D E(">>> No Patient Record Flag Assignments have been found.")
. Q
;-- prompt for selection of a flag category
I '$$FLAG Q ; Returns DGSORT("DGCAT")
;
;-- prompt for a single flag, else all flags
I $$FLAGONE<0 Q ; DGSORT("DGFLG")
;
;-- prompt for beginning date
W ! I '$$DATEBEG Q ; DGSORT("DGBEG")
;
;-- prompt for ending date
I '$$DATEEND Q ; DGSORT("DGEND")
;
;-- prompt for flag status
I '$$STATUS Q ; DGSORT("DGSTA")
;
;-- prompt for type of History records
I '$$TYPE Q ; DGSORT("DGFAC")
;
;-- prompt for device
S ZTSAVE("DGSORT(")=""
S X="Assignment Action Not Linked to a Progress Note Report"
D EN^XUTMDEVQ("START^DGPFRAL1",X,.ZTSAVE)
D HOME^%ZIS
Q
;
;----------------------- PRIVATE SUBROUTINES -----------------------
HELP(DGSEL) ;provide extended DIR("?") help text.
;
; Input: DGSEL - prompt var for help text word selection
; Output: none
;
N X S X=$S(DGSEL=1:"earliest",1:"latest")
W !," Enter "_X_" Assignment Action Date to include in the report."
W !," Please enter a date from the specified date range displayed."
Q
;
E(TX) ; press ENTER to continue prompt
I $L(TX) W !?2,TX_$C(7)
I $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
Q
;
DATEBEG() ;-- prompt for beginning date
N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
S DGDIRA="Select Beginning Date"
S DGDIRB=""
S DGDIRH="^D HELP^DGPFRAL(1)"
S DGDIRO="D^"_DGFIRST_":DT:EX"
S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
I DGASK>0 S DGSORT("DGBEG")=DGASK
Q DGASK>0
;
DATEEND() ;-- prompt for ending date
N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
S DGDIRA="Select Ending Date"
S DGDIRB=""
S DGDIRH="^D HELP^DGPFRAL(2)"
S DGDIRO="D^"_DGSORT("DGBEG")_":DT:EX"
S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
I DGASK>0 S DGSORT("DGEND")=DGASK
Q DGASK>0
;
FLAG() ;-- prompt for selection of a flag category
;;1:Category I (National);2:Category II (Local);3:Both (Category I & II)
N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
S DGDIRA="Select Flag Category"
S DGDIRB=""
S DGDIRH="Enter one of the category selections to report on"
S DGDIRO="S^"_$P($T(FLAG+1),";",3,9)
S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
I DGASK>0 S DGSORT("DGCAT")=$$PIECE(DGDIRO,DGASK)
Q DGASK>0
;
;--- start code addition by DG*5.3*960
FLAGONE() ;-- prompt for a single flag
;;
;;Press [ENTER] to run report for all flags
;;Select a single flag name for the report
;;Enter '^' to exit back to your primary menu
;;
N I,X,Y,Z,CAT,DIC,DTOUT,DUOUT
S DGSORT("DGFLG")=""
S CAT=+DGSORT("DGCAT") I CAT'=1,CAT'=2 Q 1
F I=1:1:5 W !,$TR($T(FLAGONE+I),";"," ")
S DIC=$P("26.15^26.11",U,CAT)
S DIC(0)="QAEM"
S DIC("A")="Select Category "_$E("II",1,CAT)_" Flag: "
D ^DIC W !
I Y>0 S DGSORT("DGFLG")=Y_U_(+Y)_";"_$P(DIC,U,2)
Q Y>0
;
STATUS() ;-- prompt for flag status
N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
S DGDIRA="Choose Flag Status"
S DGDIRB=""
S DGDIRH="Enter which statuses to report on"
S DGDIRO="S^1:Inactive;2:Active;3:Both active and inactive"
S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
I DGASK>0 S DGSORT("DGSTA")=$$PIECE(DGDIRO,DGASK)
Q DGASK>0
;
TYPE() ;-- prompt for type of history records
I +DGSORT("DGCAT")=2 S DGSORT("DGFAC")="1^Local Facility" Q 1
;
N X,DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
S DGDIRA="Choose Type of History Record"
S DGDIRB=""
S DGDIRH="^D TYPEH^DGPFRAL"
S X="S^1:Actions performed by local facility only;"
S X=X_"2:Actions performed by other facilities;"
S X=X_"3:Actions performed by all facilities"
S DGDIRO=X
S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) I DGASK>0 D
. S X=$P("Local Facility^Other Facilities^All Facilities",U,DGASK)
. S DGSORT("DGFAC")=DGASK_U_X
. Q
Q DGASK>0
;
TYPEH ; provide extended DIR("?") help for facility type
;;Enter the type of History Action records to display:
;;
;; Local: records created by this VAMC
;; Other: records created by other VAMCs, not this VAMC
;; Both: means to show all history records with no regard
;; for the facility that created them
;;
N I F I=1:1:7 W !,$TR($T(HELPT+I),";"," ")
Q
;
PIECE(DGIR0,DGASK) ;
N X
S X=$P(DGIR0,U,2)
S X=$P(X,";",DGASK)
S X=$P(X,":",2)
Q DGASK_U_X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFRAL 6038 printed Sep 23, 2025@20:24:27 Page 2
DGPFRAL ;ALB/RBS - PRF ACTION NOT LINKED REPORT ; 7/26/05 3:18pm
+1 ;;5.3;Registration;**554,960**;Aug 13, 1993;Build 22
+2 ; Last Edited: SHRPE/SGM - Jun 29,2018 15:14
+3 ;
+4 ; ICR# TYPE DESCRIIPTION
+5 ;----- ---- ----------------------------
+6 ; 1519 Sup EN^XUTMDEVQ
+7 ;10006 Sup ^DIC
+8 ;10086 Sup HOME^%ZIS
+9 ;
+10 ;This routine will be used for selecting sort parameters to produce
+11 ;the DGPF ACTION NOT LINKED REPORT for Patient Record Flags.
+12 ;
+13 ; Selection options will provide the ability to report by:
+14 ; CATEGORY
+15 ; BEGINNING DATE
+16 ; ENDING DATE
+17 ;
+18 ; The following reporting sort array will be built by user prompts:
+19 ; DGSORT("DGCAT") = 1^Category I (National)
+20 ; 2^Category II (Local)
+21 ; 3^Both
+22 ; DGSORT("DGBEG") = BEGINNING DATE (internal FileMan date)
+23 ; DGSORT("DGEND") = ENDING DATE (internal FileMan date)
+24 ; DGSORT("DGFAC") = 1^Local Facility Only
+25 ; 2^Other Facilities
+26 ; 3^Both
+27 ; DGSORT("DGFLG") = "" for all flags
+28 ; Else pointer^name^variable_pointer
+29 ; DGSORT("DGSTA") = 0^Inactive
+30 ; 1^Active
+31 ; 2^Both
+32 ;
+33 ;-- no direct entry
+34 QUIT
+35 ;
EN ;Entry point
+1 ;-- user prompts for report selection sorts
+2 ; DG*5.3*960 - $$FLAGONE, $$STATUS, $$TYPE
+3 ; Input: none
+4 ; Output: Report generated using user selected parameters
+5 ;
+6 ;first assignment date
NEW DGFIRST
+7 ;help text var
NEW DGSEL
+8 ;array or report parameters
NEW DGSORT
+9 ;open array reference of input parameters used by tasking
NEW ZTSAVE
+10 NEW X,Y
+11 ;
+12 ;first assignment date
SET DGFIRST=$PIECE(+$ORDER(^DGPF(26.14,"D","")),".")
+13 IF 'DGFIRST
Begin DoDot:1
+14 DO E(">>> No Patient Record Flag Assignments have been found.")
+15 QUIT
End DoDot:1
QUIT
+16 ;-- prompt for selection of a flag category
+17 ; Returns DGSORT("DGCAT")
IF '$$FLAG
QUIT
+18 ;
+19 ;-- prompt for a single flag, else all flags
+20 ; DGSORT("DGFLG")
IF $$FLAGONE<0
QUIT
+21 ;
+22 ;-- prompt for beginning date
+23 ; DGSORT("DGBEG")
WRITE !
IF '$$DATEBEG
QUIT
+24 ;
+25 ;-- prompt for ending date
+26 ; DGSORT("DGEND")
IF '$$DATEEND
QUIT
+27 ;
+28 ;-- prompt for flag status
+29 ; DGSORT("DGSTA")
IF '$$STATUS
QUIT
+30 ;
+31 ;-- prompt for type of History records
+32 ; DGSORT("DGFAC")
IF '$$TYPE
QUIT
+33 ;
+34 ;-- prompt for device
+35 SET ZTSAVE("DGSORT(")=""
+36 SET X="Assignment Action Not Linked to a Progress Note Report"
+37 DO EN^XUTMDEVQ("START^DGPFRAL1",X,.ZTSAVE)
+38 DO HOME^%ZIS
+39 QUIT
+40 ;
+41 ;----------------------- PRIVATE SUBROUTINES -----------------------
HELP(DGSEL) ;provide extended DIR("?") help text.
+1 ;
+2 ; Input: DGSEL - prompt var for help text word selection
+3 ; Output: none
+4 ;
+5 NEW X
SET X=$SELECT(DGSEL=1:"earliest",1:"latest")
+6 WRITE !," Enter "_X_" Assignment Action Date to include in the report."
+7 WRITE !," Please enter a date from the specified date range displayed."
+8 QUIT
+9 ;
E(TX) ; press ENTER to continue prompt
+1 IF $LENGTH(TX)
WRITE !?2,TX_$CHAR(7)
+2 IF $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
+3 QUIT
+4 ;
DATEBEG() ;-- prompt for beginning date
+1 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
+2 SET DGDIRA="Select Beginning Date"
+3 SET DGDIRB=""
+4 SET DGDIRH="^D HELP^DGPFRAL(1)"
+5 SET DGDIRO="D^"_DGFIRST_":DT:EX"
+6 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+7 IF DGASK>0
SET DGSORT("DGBEG")=DGASK
+8 QUIT DGASK>0
+9 ;
DATEEND() ;-- prompt for ending date
+1 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
+2 SET DGDIRA="Select Ending Date"
+3 SET DGDIRB=""
+4 SET DGDIRH="^D HELP^DGPFRAL(2)"
+5 SET DGDIRO="D^"_DGSORT("DGBEG")_":DT:EX"
+6 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+7 IF DGASK>0
SET DGSORT("DGEND")=DGASK
+8 QUIT DGASK>0
+9 ;
FLAG() ;-- prompt for selection of a flag category
+1 ;;1:Category I (National);2:Category II (Local);3:Both (Category I & II)
+2 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
+3 SET DGDIRA="Select Flag Category"
+4 SET DGDIRB=""
+5 SET DGDIRH="Enter one of the category selections to report on"
+6 SET DGDIRO="S^"_$PIECE($TEXT(FLAG+1),";",3,9)
+7 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+8 IF DGASK>0
SET DGSORT("DGCAT")=$$PIECE(DGDIRO,DGASK)
+9 QUIT DGASK>0
+10 ;
+11 ;--- start code addition by DG*5.3*960
FLAGONE() ;-- prompt for a single flag
+1 ;;
+2 ;;Press [ENTER] to run report for all flags
+3 ;;Select a single flag name for the report
+4 ;;Enter '^' to exit back to your primary menu
+5 ;;
+6 NEW I,X,Y,Z,CAT,DIC,DTOUT,DUOUT
+7 SET DGSORT("DGFLG")=""
+8 SET CAT=+DGSORT("DGCAT")
IF CAT'=1
IF CAT'=2
QUIT 1
+9 FOR I=1:1:5
WRITE !,$TRANSLATE($TEXT(FLAGONE+I),";"," ")
+10 SET DIC=$PIECE("26.15^26.11",U,CAT)
+11 SET DIC(0)="QAEM"
+12 SET DIC("A")="Select Category "_$EXTRACT("II",1,CAT)_" Flag: "
+13 DO ^DIC
WRITE !
+14 IF Y>0
SET DGSORT("DGFLG")=Y_U_(+Y)_";"_$PIECE(DIC,U,2)
+15 QUIT Y>0
+16 ;
STATUS() ;-- prompt for flag status
+1 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
+2 SET DGDIRA="Choose Flag Status"
+3 SET DGDIRB=""
+4 SET DGDIRH="Enter which statuses to report on"
+5 SET DGDIRO="S^1:Inactive;2:Active;3:Both active and inactive"
+6 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+7 IF DGASK>0
SET DGSORT("DGSTA")=$$PIECE(DGDIRO,DGASK)
+8 QUIT DGASK>0
+9 ;
TYPE() ;-- prompt for type of history records
+1 IF +DGSORT("DGCAT")=2
SET DGSORT("DGFAC")="1^Local Facility"
QUIT 1
+2 ;
+3 NEW X,DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
+4 SET DGDIRA="Choose Type of History Record"
+5 SET DGDIRB=""
+6 SET DGDIRH="^D TYPEH^DGPFRAL"
+7 SET X="S^1:Actions performed by local facility only;"
+8 SET X=X_"2:Actions performed by other facilities;"
+9 SET X=X_"3:Actions performed by all facilities"
+10 SET DGDIRO=X
+11 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
IF DGASK>0
Begin DoDot:1
+12 SET X=$PIECE("Local Facility^Other Facilities^All Facilities",U,DGASK)
+13 SET DGSORT("DGFAC")=DGASK_U_X
+14 QUIT
End DoDot:1
+15 QUIT DGASK>0
+16 ;
TYPEH ; provide extended DIR("?") help for facility type
+1 ;;Enter the type of History Action records to display:
+2 ;;
+3 ;; Local: records created by this VAMC
+4 ;; Other: records created by other VAMCs, not this VAMC
+5 ;; Both: means to show all history records with no regard
+6 ;; for the facility that created them
+7 ;;
+8 NEW I
FOR I=1:1:7
WRITE !,$TRANSLATE($TEXT(HELPT+I),";"," ")
+9 QUIT
+10 ;
PIECE(DGIR0,DGASK) ;
+1 NEW X
+2 SET X=$PIECE(DGIR0,U,2)
+3 SET X=$PIECE(X,";",DGASK)
+4 SET X=$PIECE(X,":",2)
+5 QUIT DGASK_U_X
