- DGPFRAB ;ALB/RBS - PRF APPROVED BY REPORT ; 7/26/05 3:22pm
- ;;5.3;Registration;**554,1015**;Aug 13, 1993;Build 21
- ;
- ;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
- DGPFRAB ;ALB/RBS - PRF APPROVED BY REPORT ; 7/26/05 3:22pm
- +1 ;;5.3;Registration;**554,1015**;Aug 13, 1993;Build 21
- +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