DGPFRAB ;ALB/RBS - PRF APPROVED BY REPORT ; 7/26/05 3:22pm
;;5.3;Registration;**554**;Aug 13, 1993
;
;This routine will be used for selecting sort parameters to produce
;the DGPF APPROVED BY REPORT for Patient Record Flags.
;
; Selection options will provide the ability to report by:
; APPROVED BY PERSON
; CATEGORY
; STATUS (ASSIGNMENTS)
; BEGINNING DATE
; ENDING DATE
;
; The following reporting sort array will be built by user prompts:
; DGSORT("DGAPROV") = pointer to NEW PERSON (#200) file^Person Name
; or
; = "A" = All approved by persons
; DGSORT("DGCAT") = CATEGORY
; 1^Category I (National)
; 2^Category II (Local)
; 3^Both
; DGSORT("DGSTATUS") = Assignment Status to report on
; 1^Active
; 2^Inactive
; 3^Both
; DGSORT("DGBEG") = BEGINNING DATE (internal FileMan date)
; DGSORT("DGEND") = ENDING DATE (internal FileMan date)
;
;-- no direct entry
QUIT
;
EN ;Entry point
;-- user prompts for report selection sorts
; Input: none
; Output: Report generated using user selected parameters
;
N DGABORT ;abort flag
N DGASK ;return value from $$ANSWER^DGPFUT call
N DGCAT ;flag category to report on
N DGDIRA ;DGDIRA - DIR("A") string
N DGDIRB ;DGDIRB - DIR("B") string
N DGDIRH ;DGDIRH - DIR("?") string
N DGDIRO ;DGDIR0 - DIR(0) string
N DGFIRST ;first assignment date
N DGQ ;quit flag
N DGSEL ;help text var
N DGSORT ;array or report parameters
N ZTSAVE ;open array reference of input parameters used by tasking
;
;check for database
S DGFIRST=$P(+$O(^DGPF(26.14,"D","")),".") ;first assignment date
I 'DGFIRST D Q
. W !?2,">>> No Patient Record Flag Assignments have been found.",*7
. I $$ANSWER^DGPFUT("Enter RETURN to continue","","E") ;pause
;
;-- prompt for selection of an approved by person
S DGDIRA="Select to report on a (S)ingle Approved By Person or (A)ll"
S DGDIRB="Single"
S DGDIRH="Enter one of the selections to report on"
S DGDIRO="S^S:Single Approved By Person;A:All Approved By Persons"
S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
Q:DGASK=-1!(DGASK=0)
;
S:DGASK="A" DGSORT("DGAPROV")="A"
;
D:DGASK="S"
. S (DGQ,DGABORT)=0
. F D Q:(DGQ!DGABORT)
. . S DGASK=$$ANSWER^DGPFUT("Select Approved By Person","","P^200:EMZ","Enter the person approving the record flag assignment","I $D(^DGPF(26.14,""APPRO"",+Y))")
. . I DGASK<1 S DGABORT=1 Q
. . S DGSORT("DGAPROV")=DGASK_U_$$EXTERNAL^DILFD(26.14,.05,"F",DGASK)
. . S DGQ=1
;
Q:$G(DGABORT)
;
;-- prompt for selection of a flag category
S DGDIRA="Select Flag Category"
S DGDIRB="Both"
S DGDIRH="Enter one of the category selections to report on"
S DGDIRO="S^1:Category I (National);2:Category II (Local);3:Both"
S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
Q:(DGASK<1)
S DGCAT=DGASK,DGSORT("DGCAT")=DGASK_U_$S(DGCAT=1:"Category I (National)",DGCAT=2:"Category II (Local)",DGCAT=3:"Both",1:"")
;
;-- prompt for selection of the assignment status to report on
S DGDIRA="Select Assignment Status to report on"
S DGDIRB="Both"
S DGDIRH="Enter one of the status selections to report on"
S DGDIRO="S^1:Active;2:Inactive;3:Both"
S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
Q:(DGASK<1)
S DGSORT("DGSTATUS")=DGASK_U_$S(DGASK=1:"Active",DGASK=2:"Inactive",DGASK=3:"Both",1:3)
;
;-- prompt for beginning date
S DGDIRA="Select Beginning Date"
S DGDIRB=""
S DGDIRH="^D HELP^DGPFRAB(1)"
S DGDIRO="D^"_DGFIRST_":DT:EX"
S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
Q:(DGASK=-1)
S DGSORT("DGBEG")=DGASK
;
;-- prompt for ending date
S DGDIRA="Select Ending Date"
S DGDIRB=""
S DGDIRH="^D HELP^DGPFRAB(2)"
S DGDIRO="D^"_DGSORT("DGBEG")_":DT:EX"
S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
Q:(DGASK=-1)
S DGSORT("DGEND")=DGASK
;
K DGCAT,DGDIRA,DGDIRB,DGDIRO,DGDIRH,DGASK,DGQ,DGABORT
;
;-- prompt for device
S ZTSAVE("DGSORT(")=""
D EN^XUTMDEVQ("START^DGPFRAB1","Assignments Approved By Report",.ZTSAVE)
D HOME^%ZIS
Q
;
HELP(DGSEL) ;provide extended DIR("?") help text.
;
; Input: DGSEL - prompt var for help text word selection
; Output: none
;
W !," Enter the "_$S(DGSEL=1:"earliest",1:"latest")_" Assignment Date to include in the report."
W !," Please enter a date from the specified date range displayed."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFRAB 4572 printed Apr 09, 2024@21:48:03 Page 2
DGPFRAB ;ALB/RBS - PRF APPROVED BY REPORT ; 7/26/05 3:22pm
+1 ;;5.3;Registration;**554**;Aug 13, 1993
+2 ;
+3 ;This routine will be used for selecting sort parameters to produce
+4 ;the DGPF APPROVED BY REPORT for Patient Record Flags.
+5 ;
+6 ; Selection options will provide the ability to report by:
+7 ; APPROVED BY PERSON
+8 ; CATEGORY
+9 ; STATUS (ASSIGNMENTS)
+10 ; BEGINNING DATE
+11 ; ENDING DATE
+12 ;
+13 ; The following reporting sort array will be built by user prompts:
+14 ; DGSORT("DGAPROV") = pointer to NEW PERSON (#200) file^Person Name
+15 ; or
+16 ; = "A" = All approved by persons
+17 ; DGSORT("DGCAT") = CATEGORY
+18 ; 1^Category I (National)
+19 ; 2^Category II (Local)
+20 ; 3^Both
+21 ; DGSORT("DGSTATUS") = Assignment Status to report on
+22 ; 1^Active
+23 ; 2^Inactive
+24 ; 3^Both
+25 ; DGSORT("DGBEG") = BEGINNING DATE (internal FileMan date)
+26 ; DGSORT("DGEND") = ENDING DATE (internal FileMan date)
+27 ;
+28 ;-- no direct entry
+29 QUIT
+30 ;
EN ;Entry point
+1 ;-- user prompts for report selection sorts
+2 ; Input: none
+3 ; Output: Report generated using user selected parameters
+4 ;
+5 ;abort flag
NEW DGABORT
+6 ;return value from $$ANSWER^DGPFUT call
NEW DGASK
+7 ;flag category to report on
NEW DGCAT
+8 ;DGDIRA - DIR("A") string
NEW DGDIRA
+9 ;DGDIRB - DIR("B") string
NEW DGDIRB
+10 ;DGDIRH - DIR("?") string
NEW DGDIRH
+11 ;DGDIR0 - DIR(0) string
NEW DGDIRO
+12 ;first assignment date
NEW DGFIRST
+13 ;quit flag
NEW DGQ
+14 ;help text var
NEW DGSEL
+15 ;array or report parameters
NEW DGSORT
+16 ;open array reference of input parameters used by tasking
NEW ZTSAVE
+17 ;
+18 ;check for database
+19 ;first assignment date
SET DGFIRST=$PIECE(+$ORDER(^DGPF(26.14,"D","")),".")
+20 IF 'DGFIRST
Begin DoDot:1
+21 WRITE !?2,">>> No Patient Record Flag Assignments have been found.",*7
+22 ;pause
IF $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
End DoDot:1
QUIT
+23 ;
+24 ;-- prompt for selection of an approved by person
+25 SET DGDIRA="Select to report on a (S)ingle Approved By Person or (A)ll"
+26 SET DGDIRB="Single"
+27 SET DGDIRH="Enter one of the selections to report on"
+28 SET DGDIRO="S^S:Single Approved By Person;A:All Approved By Persons"
+29 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+30 if DGASK=-1!(DGASK=0)
QUIT
+31 ;
+32 if DGASK="A"
SET DGSORT("DGAPROV")="A"
+33 ;
+34 if DGASK="S"
Begin DoDot:1
+35 SET (DGQ,DGABORT)=0
+36 FOR
Begin DoDot:2
+37 SET DGASK=$$ANSWER^DGPFUT("Select Approved By Person","","P^200:EMZ","Enter the person approving the record flag assignment","I $D(^DGPF(26.14,""APPRO"",+Y))")
+38 IF DGASK<1
SET DGABORT=1
QUIT
+39 SET DGSORT("DGAPROV")=DGASK_U_$$EXTERNAL^DILFD(26.14,.05,"F",DGASK)
+40 SET DGQ=1
End DoDot:2
if (DGQ!DGABORT)
QUIT
End DoDot:1
+41 ;
+42 if $GET(DGABORT)
QUIT
+43 ;
+44 ;-- prompt for selection of a flag category
+45 SET DGDIRA="Select Flag Category"
+46 SET DGDIRB="Both"
+47 SET DGDIRH="Enter one of the category selections to report on"
+48 SET DGDIRO="S^1:Category I (National);2:Category II (Local);3:Both"
+49 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+50 if (DGASK<1)
QUIT
+51 SET DGCAT=DGASK
SET DGSORT("DGCAT")=DGASK_U_$SELECT(DGCAT=1:"Category I (National)",DGCAT=2:"Category II (Local)",DGCAT=3:"Both",1:"")
+52 ;
+53 ;-- prompt for selection of the assignment status to report on
+54 SET DGDIRA="Select Assignment Status to report on"
+55 SET DGDIRB="Both"
+56 SET DGDIRH="Enter one of the status selections to report on"
+57 SET DGDIRO="S^1:Active;2:Inactive;3:Both"
+58 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+59 if (DGASK<1)
QUIT
+60 SET DGSORT("DGSTATUS")=DGASK_U_$SELECT(DGASK=1:"Active",DGASK=2:"Inactive",DGASK=3:"Both",1:3)
+61 ;
+62 ;-- prompt for beginning date
+63 SET DGDIRA="Select Beginning Date"
+64 SET DGDIRB=""
+65 SET DGDIRH="^D HELP^DGPFRAB(1)"
+66 SET DGDIRO="D^"_DGFIRST_":DT:EX"
+67 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+68 if (DGASK=-1)
QUIT
+69 SET DGSORT("DGBEG")=DGASK
+70 ;
+71 ;-- prompt for ending date
+72 SET DGDIRA="Select Ending Date"
+73 SET DGDIRB=""
+74 SET DGDIRH="^D HELP^DGPFRAB(2)"
+75 SET DGDIRO="D^"_DGSORT("DGBEG")_":DT:EX"
+76 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+77 if (DGASK=-1)
QUIT
+78 SET DGSORT("DGEND")=DGASK
+79 ;
+80 KILL DGCAT,DGDIRA,DGDIRB,DGDIRO,DGDIRH,DGASK,DGQ,DGABORT
+81 ;
+82 ;-- prompt for device
+83 SET ZTSAVE("DGSORT(")=""
+84 DO EN^XUTMDEVQ("START^DGPFRAB1","Assignments Approved By Report",.ZTSAVE)
+85 DO HOME^%ZIS
+86 QUIT
+87 ;
HELP(DGSEL) ;provide extended DIR("?") help text.
+1 ;
+2 ; Input: DGSEL - prompt var for help text word selection
+3 ; Output: none
+4 ;
+5 WRITE !," Enter the "_$SELECT(DGSEL=1:"earliest",1:"latest")_" Assignment Date to include in the report."
+6 WRITE !," Please enter a date from the specified date range displayed."
+7 QUIT
