source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPFRFR.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.5 KB
Line 
1DGPFRFR ;ALB/RBS - PRF ASSIGNMENTS DUE REVIEW REPORT ; 10/28/03 12:04pm
2 ;;5.3;Registration;**425,555**;Aug 13, 1993
3 ;
4 ;This routine will be used for selecting sort parameters to produce
5 ; the FLAGS DUE FOR REVIEW REPORT for Patient Record Flags.
6 ;
7 ;Selection options will provide the user with the ability to report
8 ; by:
9 ; CATEGORY:
10 ; 1 Category I (National)
11 ; 2 Category II (Local)
12 ; 3 BOTH
13 ; FLAG:
14 ; S Single Flag
15 ; A All Flags
16 ; BEGINING DATE: FileMan date
17 ; ENDING DATE: FileMan date
18 ;
19 ;-- no direct entry
20 QUIT
21 ;
22EN ;Entry point
23 ;-- user prompts for report selection sorts
24 ; Input: none
25 ; Output: Report generated using user selected parameters
26 ;
27 N DGASK,DGRSLT,DGDIRA,DGDIRB,DGDIRO,DGDIRH
28 N DGSORT,DGCAT,DGFIL,DGSEL,DGNOW,DGFIRST,DGBEG,DGEND
29 N ZTSAVE,DGQ
30 ;
31 ;-- prompt for selection of a flag category
32 S DGDIRA="Select Flag Category",DGDIRB=""
33 S DGDIRH="Enter one of the category selections to report on"
34 S DGDIRO="S^1:Category I (National);2:Category II (Local);3:Both"
35 S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
36 Q:(DGASK<1)
37 S DGCAT=DGASK,DGSORT("DGCAT")=DGASK_U_$S(DGASK=1:"Category I (National)",DGASK=2:"Category II (Local)",DGASK=3:"Both",1:"")
38 ;
39 ;-- prompt for selection of a single flag or all flags
40 S DGSEL=""
41 ;default to (A)ll flags if user selects Both Category's
42 I DGCAT=3 D
43 . S DGSORT("DGFLAG")="A"
44 ;
45 D:DGCAT'=3 ;only prompt if user selects a Category I or II
46 . S DGDIRA="Select to report on a (S)ingle flag or (A)ll flags"
47 . S DGDIRB="Single Flag"
48 . S DGDIRO="S^S:Single Flag;A:All Flags"
49 . S DGDIRH="Enter one of the flag selections to report on"
50 . S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
51 . Q:(DGASK=-1)
52 . S DGSEL=DGASK
53 . S DGSORT("DGFLAG")=DGASK
54 Q:(DGASK=-1)
55 ;
56 ;-- prompt for selection of a record flag name - only if (S)ingle
57 D:DGSEL="S"
58 . S DGQ=0
59 . S DGDIRA="Select Record Flag Name"
60 . S DGDIRB=""
61 . S DGDIRO=$S(DGCAT=1:"P^26.15,.01:EMZ",1:"P^26.11,.01:EMZ")
62 . F D Q:DGQ
63 . . S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO)
64 . . I DGASK=-1 S DGQ=1 Q
65 . . ;set data string = pointer value (5;DGPF(26.11,) ^ external name
66 . . S DGFIL=DGASK_$S(DGCAT=1:";DGPF(26.15,",1:";DGPF(26.11,")
67 . . ;if (S)ingle flag selected, check for any flag assignments
68 . . I '$$ASGNCNT^DGPFLF6(DGFIL) D Q
69 . . . W !?2,">>> No Patient Record Flag Assignments have been found. Select another flag.",*7
70 . . ;a good one to report on
71 . . S DGSORT("DGFLAG")=DGFIL_U_$$EXTERNAL^DILFD(26.13,.02,"F",DGFIL)
72 . . S DGQ=1
73 ;
74 Q:(DGASK=-1)
75 ;
76 ;-- prompt for beginning date
77 S DGNOW=$$DT^XLFDT()
78 S DGFIRST=$P(+$O(^DGPF(26.13,"AFREV","")),".") ;first review date
79 I 'DGFIRST D Q
80 . W !?2,">>> No Patient Record Flag Assignments have been found.",*7
81 . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
82 ;
83 S DGDIRA="Select Beginning Date"
84 S DGDIRB=""
85 S DGDIRH="Enter the earliest Review Date to include in the report"
86 S DGDIRO="D^::EX"
87 S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
88 Q:(DGASK=-1)
89 S (DGSORT("DGBEG"),DGBEG)=DGASK
90 ;
91 ;-- prompt for ending date
92 S DGDIRA="Select Ending Date"
93 S DGDIRB=""
94 S DGDIRH="Enter the latest Review Date to include in the report"
95 S DGDIRO="D^::EX"
96 S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
97 Q:(DGASK=-1)
98 S DGSORT("DGEND")=DGASK
99 S DGSORT("DGNOW")=DGNOW
100 ;
101 K DGCAT,DGFIL,DGSEL,DGDIRA,DGDIRB,DGDIRO
102 K DGASK,DGRSLT,DGNOW,DGFIRST,DGBEG
103 ;
104 ;-- prompt for device
105 S ZTSAVE("DGSORT(")=""
106 D EN^XUTMDEVQ("START^DGPFRFR1","Flags Due For Review Report",.ZTSAVE)
107 D HOME^%ZIS
108 Q
Note: See TracBrowser for help on using the repository browser.