DGPFRPI ;ALB/RBS - PRF PRINCIPAL INVEST REPORT ; 7/26/05 3:39pm
;;5.3;Registration;**554,730**;Aug 13, 1993;Build 2
;
;This routine will be used for selecting sort parameters to produce
;the DGPF PRINCIPAL INVEST REPORT for Patient Record Flags.
;
; Selection options will provide the ability to report by:
; PRINCIPAL INVESTIGATOR
; CATEGORY
; STATUS (ASSIGNMENTS)
; BEGINNING DATE
; ENDING DATE
;
; The following reporting sort array will be built by user prompts:
; DGSORT("DGPRINC") = pointer to NEW PERSON (#200) file^Person Name
; or
; = "A" = All Principal Investigator's
; DGSORT("DGCAT") = CATEGORY
; 2^Category II (Local)
; 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 DGDIRA ;DGDIRA - DIR("A") string
N DGDIRB ;DGDIRB - DIR("B") string
N DGDIRH ;DGDIRH - DIR("?") string
N DGDIRO ;DGDIR0 - DIR(0) string
N DGDIRS ;DGDIRS - DIR("S") 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 Principal Investigator or (A)ll"
S DGDIRB="Single"
S DGDIRH="Enter one of the selections to report on"
S DGDIRO="S^S:Single Principal Investigator;A:All Principal Investigators"
S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
Q:DGASK=-1!(DGASK=0)
;
S:DGASK="A" DGSORT("DGPRINC")="A"
;
D:DGASK="S"
.S (DGQ,DGABORT)=0
.N DIC,D,X,Y,I
.S DIC="^DGPF(26.11,"
.S DIC(0)="AEQZ"
.S D="C"
.S DIC("A")="Select Principal Investigator's name: "
.D IX^DIC
.I Y<0 S DGABORT=1 Q
.S I=0
.F S I=$O(^DGPF(26.11,+Y,2,"B",I)) Q:'I I $P(^VA(200,I,0),U)[X Q
.I '$G(I) S DGABORT=1 Q
.S DGSORT("DGPRINC")=I_U_$$EXTERNAL^DILFD(26.112,.01,"F",I)
.S DGQ=1
;
Q:$G(DGABORT)
;
;-- prompt for selection of a flag category
; only Cat II (Local) file (#26.11) has Research Flags
S DGSORT("DGCAT")=2_U_"Category II (Local)"
;
;-- 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^DGPFRPI(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^DGPFRPI(2)"
S DGDIRO="D^"_DGSORT("DGBEG")_":DT:EX"
S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
Q:(DGASK=-1)
S DGSORT("DGEND")=DGASK
;
K DGDIRA,DGDIRB,DGDIRO,DGDIRH,DGDIRS,DGASK,DGQ,DGABORT
;
;-- prompt for device
S ZTSAVE("DGSORT(")=""
D EN^XUTMDEVQ("START^DGPFRPI1","Assignments By Principle Investigator 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[HDGPFRPI 4303 printed Apr 09, 2024@21:56:48 Page 2
DGPFRPI ;ALB/RBS - PRF PRINCIPAL INVEST REPORT ; 7/26/05 3:39pm
+1 ;;5.3;Registration;**554,730**;Aug 13, 1993;Build 2
+2 ;
+3 ;This routine will be used for selecting sort parameters to produce
+4 ;the DGPF PRINCIPAL INVEST REPORT for Patient Record Flags.
+5 ;
+6 ; Selection options will provide the ability to report by:
+7 ; PRINCIPAL INVESTIGATOR
+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("DGPRINC") = pointer to NEW PERSON (#200) file^Person Name
+15 ; or
+16 ; = "A" = All Principal Investigator's
+17 ; DGSORT("DGCAT") = CATEGORY
+18 ; 2^Category II (Local)
+19 ; DGSORT("DGSTATUS") = Assignment Status to report on
+20 ; 1^Active
+21 ; 2^Inactive
+22 ; 3^Both
+23 ; DGSORT("DGBEG") = BEGINNING DATE (internal FileMan date)
+24 ; DGSORT("DGEND") = ENDING DATE (internal FileMan date)
+25 ;
+26 ;-- no direct entry
+27 QUIT
+28 ;
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 ;DGDIRA - DIR("A") string
NEW DGDIRA
+8 ;DGDIRB - DIR("B") string
NEW DGDIRB
+9 ;DGDIRH - DIR("?") string
NEW DGDIRH
+10 ;DGDIR0 - DIR(0) string
NEW DGDIRO
+11 ;DGDIRS - DIR("S") string
NEW DGDIRS
+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 Principal Investigator or (A)ll"
+26 SET DGDIRB="Single"
+27 SET DGDIRH="Enter one of the selections to report on"
+28 SET DGDIRO="S^S:Single Principal Investigator;A:All Principal Investigators"
+29 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+30 if DGASK=-1!(DGASK=0)
QUIT
+31 ;
+32 if DGASK="A"
SET DGSORT("DGPRINC")="A"
+33 ;
+34 if DGASK="S"
Begin DoDot:1
+35 SET (DGQ,DGABORT)=0
+36 NEW DIC,D,X,Y,I
+37 SET DIC="^DGPF(26.11,"
+38 SET DIC(0)="AEQZ"
+39 SET D="C"
+40 SET DIC("A")="Select Principal Investigator's name: "
+41 DO IX^DIC
+42 IF Y<0
SET DGABORT=1
QUIT
+43 SET I=0
+44 FOR
SET I=$ORDER(^DGPF(26.11,+Y,2,"B",I))
if 'I
QUIT
IF $PIECE(^VA(200,I,0),U)[X
QUIT
+45 IF '$GET(I)
SET DGABORT=1
QUIT
+46 SET DGSORT("DGPRINC")=I_U_$$EXTERNAL^DILFD(26.112,.01,"F",I)
+47 SET DGQ=1
End DoDot:1
+48 ;
+49 if $GET(DGABORT)
QUIT
+50 ;
+51 ;-- prompt for selection of a flag category
+52 ; only Cat II (Local) file (#26.11) has Research Flags
+53 SET DGSORT("DGCAT")=2_U_"Category II (Local)"
+54 ;
+55 ;-- prompt for selection of the assignment status to report on
+56 SET DGDIRA="Select Assignment Status to report on"
+57 SET DGDIRB="Both"
+58 SET DGDIRH="Enter one of the status selections to report on"
+59 SET DGDIRO="S^1:Active;2:Inactive;3:Both"
+60 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+61 if (DGASK<1)
QUIT
+62 SET DGSORT("DGSTATUS")=DGASK_U_$SELECT(DGASK=1:"Active",DGASK=2:"Inactive",DGASK=3:"Both",1:3)
+63 ;
+64 ;-- prompt for beginning date
+65 SET DGDIRA="Select Beginning Date"
+66 SET DGDIRB=""
+67 SET DGDIRH="^D HELP^DGPFRPI(1)"
+68 SET DGDIRO="D^"_DGFIRST_":DT:EX"
+69 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+70 if (DGASK=-1)
QUIT
+71 SET DGSORT("DGBEG")=DGASK
+72 ;
+73 ;-- prompt for ending date
+74 SET DGDIRA="Select Ending Date"
+75 SET DGDIRB=""
+76 SET DGDIRH="^D HELP^DGPFRPI(2)"
+77 SET DGDIRO="D^"_DGSORT("DGBEG")_":DT:EX"
+78 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+79 if (DGASK=-1)
QUIT
+80 SET DGSORT("DGEND")=DGASK
+81 ;
+82 KILL DGDIRA,DGDIRB,DGDIRO,DGDIRH,DGDIRS,DGASK,DGQ,DGABORT
+83 ;
+84 ;-- prompt for device
+85 SET ZTSAVE("DGSORT(")=""
+86 DO EN^XUTMDEVQ("START^DGPFRPI1","Assignments By Principle Investigator Report",.ZTSAVE)
+87 DO HOME^%ZIS
+88 QUIT
+89 ;
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
