DGPFRFR.m

DGPFRFR ;ALB/RBS - PRF ASSIGNMENTS DUE REVIEW REPORT ; 10/28/03 12:04pm

 ;;5.3;Registration;**425,555,1015**;Aug 13, 1993;Build 21

 ;

 ;This routine will be used for selecting sort parameters to produce

 ; the FLAGS DUE FOR REVIEW REPORT for Patient Record Flags.

 ;

 ;Selection options will provide the user with the ability to report

 ; by:

 ;  CATEGORY:

 ;    1  Category I (National)

 ;    2  Category II (Local)

 ;    3  BOTH

 ;  FLAG:

 ;    S  Single Flag

 ;    A  All Flags

 ;  BEGINING DATE:  FileMan date

 ;  ENDING DATE:    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 DGASK,DGRSLT,DGDIRA,DGDIRB,DGDIRO,DGDIRH

 N DGSORT,DGCAT,DGFIL,DGSEL,DGNOW,DGFIRST,DGBEG,DGEND

 N ZTSAVE,DGQ

 ;

 ;-- prompt for selection of a flag category

 S DGDIRA="Select Flag Category",DGDIRB=""

 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(DGASK=1:"Category I (National)",DGASK=2:"Category II (Local)",DGASK=3:"Both",1:"")

 ;

 ;-- prompt for selection of a single flag or all flags

 S DGSEL=""

 ;default to (A)ll flags if user selects Both Category's

 I DGCAT=3 D

 . S DGSORT("DGFLAG")="A"

 ;

 D:DGCAT'=3  ;only prompt if user selects a Category I or II

 . S DGDIRA="Select to report on a (S)ingle flag or (A)ll flags"

 . S DGDIRB="Single Flag"

 . S DGDIRO="S^S:Single Flag;A:All Flags"

 . S DGDIRH="Enter one of the flag selections to report on"

 . S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)

 . Q:(DGASK=-1)

 . S DGSEL=DGASK

 . S DGSORT("DGFLAG")=DGASK

 Q:(DGASK=-1)

 ;

 ;-- prompt for selection of a record flag name - only if (S)ingle

 D:DGSEL="S"

 . S DGQ=0

 . S DGDIRA="Select Record Flag Name"

 . S DGDIRB=""

 . S DGDIRO=$S(DGCAT=1:"P^26.15,.01:EMZ",1:"P^26.11,.01:EMZ")

 . F  D  Q:DGQ

 . . S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO)

 . . I DGASK=-1 S DGQ=1 Q

 . . ;set data string = pointer value (5;DGPF(26.11,) ^ external name

 . . S DGFIL=DGASK_$S(DGCAT=1:";DGPF(26.15,",1:";DGPF(26.11,")

 . . ;if (S)ingle flag selected, check for any flag assignments

 . . I '$$ASGNCNT^DGPFLF6(DGFIL) D  Q

 . . . W !?2,">>> No Patient Record Flag Assignments have been found.  Select another flag.",*7

 . . ;a good one to report on

 . . S DGSORT("DGFLAG")=DGFIL_U_$$EXTERNAL^DILFD(26.13,.02,"F",DGFIL)

 . . S DGQ=1

 ;

 Q:(DGASK=-1)

 ;

 ;-- prompt for beginning date

 S DGNOW=$$DT^XLFDT()

 S DGFIRST=$P(+$O(^DGPF(26.13,"AFREV","")),".")  ;first review date

 I 'DGFIRST D  Q

 . W !?2,">>> No Patient Record Flag Assignments have been found.",*7

 . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E")

 ;

 S DGDIRA="Select Beginning Date"

 S DGDIRB=""

 S DGDIRH="Enter the earliest Review Date to include in the report"

 S DGDIRO="D^::EX"

 S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)

 Q:(DGASK=-1)

 S (DGSORT("DGBEG"),DGBEG)=DGASK

 ;

 ;-- prompt for ending date

 S DGDIRA="Select Ending Date"

 S DGDIRB=""

 S DGDIRH="Enter the latest Review Date to include in the report"

 S DGDIRO="D^::EX"

 S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)

 Q:(DGASK=-1)

 S DGSORT("DGEND")=DGASK

 S DGSORT("DGNOW")=DGNOW

 ;

 K DGCAT,DGFIL,DGSEL,DGDIRA,DGDIRB,DGDIRO

 K DGASK,DGRSLT,DGNOW,DGFIRST,DGBEG

 ;

 ;-- prompt for device

 S ZTSAVE("DGSORT(")=""

 D EN^XUTMDEVQ("START^DGPFRFR1","Flags Due For Review Report",.ZTSAVE)

 D HOME^%ZIS

 Q

DGPFRFR   ;ALB/RBS - PRF ASSIGNMENTS DUE REVIEW REPORT ; 10/28/03 12:04pm

 +1       ;;5.3;Registration;**425,555,1015**;Aug 13, 1993;Build 21

 +2       ;

 +3       ;This routine will be used for selecting sort parameters to produce

 +4       ; the FLAGS DUE FOR REVIEW REPORT for Patient Record Flags.

 +5       ;

 +6       ;Selection options will provide the user with the ability to report

 +7       ; by:

 +8       ;  CATEGORY:

 +9       ;    1  Category I (National)

 +10      ;    2  Category II (Local)

 +11      ;    3  BOTH

 +12      ;  FLAG:

 +13      ;    S  Single Flag

 +14      ;    A  All Flags

 +15      ;  BEGINING DATE:  FileMan date

 +16      ;  ENDING DATE:    FileMan date

 +17      ;

 +18      ;-- no direct entry

 +19       QUIT 

 +20      ;

EN        ;Entry point

 +1       ;-- user prompts for report selection sorts

 +2       ;  Input: none

 +3       ; Output: Report generated using user selected parameters

 +4       ;

 +5        NEW DGASK,DGRSLT,DGDIRA,DGDIRB,DGDIRO,DGDIRH

 +6        NEW DGSORT,DGCAT,DGFIL,DGSEL,DGNOW,DGFIRST,DGBEG,DGEND

 +7        NEW ZTSAVE,DGQ

 +8       ;

 +9       ;-- prompt for selection of a flag category

 +10       SET DGDIRA="Select Flag Category"

           SET DGDIRB=""

 +11       SET DGDIRH="Enter one of the category selections to report on"

 +12       SET DGDIRO="S^1:Category I (National);2:Category II (Local);3:Both"

 +13       SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)

 +14       IF (DGASK<1)

               QUIT 

 +15       SET DGCAT=DGASK

           SET DGSORT("DGCAT")=DGASK_U_$SELECT(DGASK=1:"Category I (National)",DGASK=2:"Category II (Local)",DGASK=3:"Both",1:"")

 +16      ;

 +17      ;-- prompt for selection of a single flag or all flags

 +18       SET DGSEL=""

 +19      ;default to (A)ll flags if user selects Both Category's

 +20       IF DGCAT=3

               Begin DoDot:1

 +21               SET DGSORT("DGFLAG")="A"

               End DoDot:1

 +22      ;

 +23      ;only prompt if user selects a Category I or II

           IF DGCAT'=3

               Begin DoDot:1

 +24               SET DGDIRA="Select to report on a (S)ingle flag or (A)ll flags"

 +25               SET DGDIRB="Single Flag"

 +26               SET DGDIRO="S^S:Single Flag;A:All Flags"

 +27               SET DGDIRH="Enter one of the flag selections to report on"

 +28               SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)

 +29               IF (DGASK=-1)

                       QUIT 

 +30               SET DGSEL=DGASK

 +31               SET DGSORT("DGFLAG")=DGASK

               End DoDot:1

 +32       IF (DGASK=-1)

               QUIT 

 +33      ;

 +34      ;-- prompt for selection of a record flag name - only if (S)ingle

 +35       IF DGSEL="S"

               Begin DoDot:1

 +36               SET DGQ=0

 +37               SET DGDIRA="Select Record Flag Name"

 +38               SET DGDIRB=""

 +39               SET DGDIRO=$SELECT(DGCAT=1:"P^26.15,.01:EMZ",1:"P^26.11,.01:EMZ")

 +40               FOR 

                       Begin DoDot:2

 +41                       SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO)

 +42                       IF DGASK=-1

                               SET DGQ=1

                               QUIT 

 +43      ;set data string = pointer value (5;DGPF(26.11,) ^ external name

 +44                       SET DGFIL=DGASK_$SELECT(DGCAT=1:";DGPF(26.15,",1:";DGPF(26.11,")

 +45      ;if (S)ingle flag selected, check for any flag assignments

 +46                       IF '$$ASGNCNT^DGPFLF6(DGFIL)

                               Begin DoDot:3

 +47                               WRITE !?2,">>> No Patient Record Flag Assignments have been found.  Select another flag.",*7

                               End DoDot:3

                               QUIT 

 +48      ;a good one to report on

 +49                       SET DGSORT("DGFLAG")=DGFIL_U_$$EXTERNAL^DILFD(26.13,.02,"F",DGFIL)

 +50                       SET DGQ=1

                       End DoDot:2

                       IF DGQ

                           QUIT 

               End DoDot:1

 +51      ;

 +52       IF (DGASK=-1)

               QUIT 

 +53      ;

 +54      ;-- prompt for beginning date

 +55       SET DGNOW=$$DT^XLFDT()

 +56      ;first review date

           SET DGFIRST=$PIECE(+$ORDER(^DGPF(26.13,"AFREV","")),".")

 +57       IF 'DGFIRST

               Begin DoDot:1

 +58               WRITE !?2,">>> No Patient Record Flag Assignments have been found.",*7

 +59               IF $$ANSWER^DGPFUT("Enter RETURN to continue","","E")

               End DoDot:1

               QUIT 

 +60      ;

 +61       SET DGDIRA="Select Beginning Date"

 +62       SET DGDIRB=""

 +63       SET DGDIRH="Enter the earliest Review Date to include in the report"

 +64       SET DGDIRO="D^::EX"

 +65       SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)

 +66       IF (DGASK=-1)

               QUIT 

 +67       SET (DGSORT("DGBEG"),DGBEG)=DGASK

 +68      ;

 +69      ;-- prompt for ending date

 +70       SET DGDIRA="Select Ending Date"

 +71       SET DGDIRB=""

 +72       SET DGDIRH="Enter the latest Review Date to include in the report"

 +73       SET DGDIRO="D^::EX"

 +74       SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)

 +75       IF (DGASK=-1)

               QUIT 

 +76       SET DGSORT("DGEND")=DGASK

 +77       SET DGSORT("DGNOW")=DGNOW

 +78      ;

 +79       KILL DGCAT,DGFIL,DGSEL,DGDIRA,DGDIRB,DGDIRO

 +80       KILL DGASK,DGRSLT,DGNOW,DGFIRST,DGBEG

 +81      ;

 +82      ;-- prompt for device

 +83       SET ZTSAVE("DGSORT(")=""

 +84       DO EN^XUTMDEVQ("START^DGPFRFR1","Flags Due For Review Report",.ZTSAVE)

 +85       DO HOME^%ZIS

 +86       QUIT