DGPFRFR1 ;ALB/RBS - PRF ASSIGNMENTS DUE REVIEW REPORT CONT. ; 5/21/03 4:40pm
 ;;5.3;Registration;**425**;Aug 13, 1993
 ;
 ;This routine will create the ASSIGNMENTS DUE FOR REVIEW REPORT.
 ;This routine will be used to display or print all of the patient
 ; assignments due for Review for Category I and Category II PRF's.
 ;
 ;All sort input was created in routine DGPFRFR.
 ; Input: The following array contains the sort var's:
 ;   DGSORT("DGCAT")  = category reporting on (I, II, or (B)oth)
 ;   DGSORT("DGFLAG") = "A" = (A)ll Flags will be reported on
 ;                    = IEN of a (S)ingle Flag (#26.11)/(#26.15)
 ;                        example:  "1;DGPF(26.15,"
 ;   DGSORT("DGBEG")  = Beginning date to report on
 ;   DGSORT("DGEND")  = Ending date to report on
 ;
 ; Output: Formatted report of Record Flag Assignments due for review.
 ;
 ;- no direct entry
 QUIT
 ;
START ; compile and print report
 I $E(IOST)="C" D WAIT^DICD
 N DGLIST
 S DGLIST=$NA(^TMP("DGPFRFR1",$J))
 K @DGLIST
 D LOOP(.DGSORT)
 D PRINT(.DGSORT,DGLIST)
 D EXIT
 Q
 ;
LOOP(DGSORT) ;use sort var's for record searching to build list
 ;  Input:
 ;      DGSORT - array of user selected report parameters
 ;
 ; Output:
 ;      ^TMP("DGPFRFA1",$J) - temp global containing report output
 ;
 N DGCAT,DGFLAG,DGBEG,DGEND,DGIEN,DGDFN,DGC,DGX,DGQ,DGFG,DGSUB,DGNOW
 S (DGQ,DGFG)=0
 S DGX="" F  S DGX=$O(DGSORT(DGX)) Q:DGX=""  S @DGX=DGSORT(DGX)
 S DGC=$S(+DGCAT=3:0,1:+DGCAT)  ; 0 = both cat. I,II (National,Local)
 S:DGC DGC=$S(DGC=1:26.15,1:26.11)
 S DGFG=$P(DGFLAG,U)   ;"A"=all flags or "5;DGPF(26.11," is selection
 S DGSUB=DGBEG-1  ; seed var to start at user selected beginning date
 F  S DGSUB=$O(^DGPF(26.13,"AFREV",DGSUB)) Q:DGSUB=""  D  Q:DGQ
 . I DGSUB>DGEND S DGQ=1 Q
 . S DGDFN=""
 . F  S DGDFN=$O(^DGPF(26.13,"AFREV",DGSUB,DGDFN)) Q:DGDFN=""  D
 .. S DGIEN=""
 .. F  S DGIEN=$O(^DGPF(26.13,"AFREV",DGSUB,DGDFN,DGIEN)) Q:DGIEN=""  D
 ... Q:'$D(^DGPF(26.13,"D",DGDFN,1,DGIEN))  ;status not active
 ... I +DGFG,'$D(^DGPF(26.13,"C",DGDFN,DGFG,DGIEN)) Q  ;flag not found
 ... D BLDTMP(.DGSORT,DGDFN,DGIEN,DGLIST)
 Q
 ;
BLDTMP(DGSORT,DGDFN,DGIEN,DGLIST) ; list global builder
 ;  Input:
 ;      DGSORT - array of user selected report parameters
 ;      DGDFN  - ien of patient in PATIENT (#2) file
 ;      DGIEN  - ien pointer to PRF ASSIGNMENT (#26.13) file record
 ;
 ; Output:
 ;      ^TMP("DGPFRFA1",$J) - temp global containing report output
 ;
 N DGPFA,DGPFAH,DGPFPAT,DGPTR,DGINIT,DGCATG
 N DGLINE,DGNAME,DGREV,DGFG,DGNOT,DGYN
 S (DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV,DGNOT,DGYN)=""
 K DGPFA,DGPFAH,DGPFPAT
 ;retrieve a single assign record
 Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)
 I +DGC,$P(DGPFA("FLAG"),U)'[+DGC Q   ;not category selected
 ;retrieve initial history assign record
 Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH)
 ;-- get 'initial assignment' date
 S DGPFAH("INITASSIGN")=$G(DGPFAH("ASSIGNDT"))
 Q:'DGPFAH("INITASSIGN")
 Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPFPAT)
 S DGCATG=$S($P(DGPFA("FLAG"),U)[26.15:1,1:2)
 S DGFG=$P(DGPFA("FLAG"),U,2)
 S DGNAME=DGPFPAT("NAME")
 S DGINIT=$$FDATE^VALM1(+DGPFAH("INITASSIGN"))
 I +DGPFA("REVIEWDT") D
 . S DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
 . I +DGPFA("REVIEWDT")<DGNOW S DGREV=DGREV_" *"  ;past due indicator
 . ; calulate the notification date
 . S DGNOT=$$NOTIFYDT^DGPFAA3($P(DGPFA("FLAG"),U),$P(DGPFA("REVIEWDT"),U))
 . S DGYN=$S($D(^DGPF(26.13,"ANDAT",DGNOT,DGIEN)):"NO",1:"YES")
 E  S (DGREV,DGNOT,DGYN)="N/A"
 S DGLINE=DGPFPAT("SSN")_U_DGINIT_U_DGREV_U_DGYN
 S @DGLIST@(DGCATG,DGFG,DGNAME,DGDFN)=DGLINE
 K DGPFA,DGPFAH,DGPFPAT
 Q
 ;
PRINT(DGSORT,DGLIST) ;output report
 ;  Input:
 ;      DGSORT - array of user selected report parameters
 ;
 ; Output: Formated report to user selected device
 ;
 N DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGQ,DGPAGE,DGDT,DGCNT,DGOFG,X,Y,DGGRAND,DGLINE
 S (DGCNT,DGQ,DGPAGE,DGGRAND)=0,$P(DGLINE,"-",80)=""
 S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
 I $O(@DGLIST@(""))="" D  Q
 . S DGCAT=+DGSORT("DGCAT")
 . S DGFG=$S(DGSORT("DGFLAG")="A":"(A)ll Flags",1:$P(DGSORT("DGFLAG"),U,2))
 . D HEAD
 . W !!,"   >>> No Record Flag Assignments were found using the report criteria."
 ; loop and print report
 S (DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGOFG)=""
 F  S DGCAT=$O(@DGLIST@(DGCAT)) Q:DGCAT=""  D  Q:DGQ
 . F  S DGFG=$O(@DGLIST@(DGCAT,DGFG)) Q:DGFG=""  D  Q:DGQ
 .. I DGFG'=DGOFG D
 ... D:DGCNT SUB(.DGCNT,1)
 ... D HEAD
 ... S DGOFG=DGFG,DGCNT=0
 .. F  S DGNAM=$O(@DGLIST@(DGCAT,DGFG,DGNAM)) Q:DGNAM=""  D  Q:DGQ
 ... F  S DGDFN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN=""  D  Q:DGQ
 .... S DGCNT=DGCNT+1,DGCNT(DGCAT)=$G(DGCNT(DGCAT))+1
 .... D:$Y>(IOSL-4) HEAD
 .... Q:DGQ
 .... S DGSTR=$G(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN))
 .... W !,$E(DGNAM,1,20),?22,$P(DGSTR,U),?33,$P(DGSTR,U,2),?43,$P(DGSTR,U,3),?60,$P(DGSTR,U,4)
 . Q:DGQ
 . I DGCNT D
 .. D SUB(.DGCNT,1)
 .. D:DGSORT("DGFLAG")="A" SUB(.DGCNT,2)  ;only if (A)ll flags
 .. S DGOFG="",DGCNT=0
 ;
 ;Shutdown if stop task requested
 I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
 ;
 I +DGSORT("DGCAT")=3 D  ; Grand totals (B)oth Categories
 . S DGCAT=3,DGFG="All Flags",DGGRAND=1
 . D HEAD
 . W !!,"REPORT SUMMARY:",!,"---------------"
 . F DGCAT=1,2,3 D
 .. S:DGCAT'=3 DGCNT(3)=$G(DGCNT(3))+$G(DGCNT(DGCAT))
 .. W:DGCAT=3 !?46,"-------"
 .. W !,"Total Review Assignments for Category "
 .. W $S(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":"
 .. W ?47,$J(+$G(DGCNT(DGCAT)),6)
 ;
 W !!,"<End of Report>"
 Q
 ;
PAUSE(DGQ) ; pause screen display
 ;  Input:
 ;      DGQ - var used to quit report processing to user CRT
 ; Output:
 ;      DGQ - passed by reference - 0 = Continue, 1 = Quit
 ;
 I $G(DGPAGE)>0,$E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1
 Q
 ;
SUB(CNT,TYP) ; print sub-totals
 ;  Input:
 ;      CNT - count of records printed
 ;      TYP - indicator of which total count is being printed
 ; Output: Write lines of Sub-Totals and Totals per Flag and Category
 ;
 N DGTYPE,DGCOUNT
 S DGTYPE=$S(TYP=1:"Flag",2:"Category "_$S(DGCAT=1:"I",1:"II"))
 S DGCOUNT=$S(TYP=1:CNT,1:DGCNT(DGCAT))
 W:TYP=1 !
 W !,"Total Review Assignments for "_DGTYPE_":  ",DGCOUNT
 W:TYP=1 !,"Note:  "" * "" indicates that review date is past due",!
 Q
 ;
HEAD ;Print/Display page header
 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
 D PAUSE(.DGQ)
 Q:DGQ
 W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
 S DGPAGE=$G(DGPAGE)+1
 W !?22,"PATIENT RECORD FLAGS"
 W !?16,"ASSIGNMENTS DUE FOR REVIEW REPORT",?70,"Page: ",$G(DGPAGE)
 W !?16,"---------------------------------",?51,"Printed: ",DGDT
 W !?2,"CATEGORY: "_$S($G(DGCAT)=1:"Category I (National)",$G(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
 W !,"DATE RANGE: ",$$FDATE^VALM1($G(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($G(DGSORT("DGEND")))
 W !?1,"FLAG NAME: ",$G(DGFG),!
 I DGGRAND W DGLINE Q
 W !,"PATIENT NAME",?22,"SSN",?33,"ASSIGNED",?43,"REVIEW DT",?54,"NOTIFICATION SENT"
 W !,"--------------------",?22,"---------",?33,"--------",?43,"---------",?54,"-----------------"
 Q
 ;
EXIT ;
 I $D(ZTQUEUED) S ZTREQ="@"
 K @DGLIST
 I '$D(ZTQUEUED) D
 . K %ZIS,POP
 . D ^%ZISC,HOME^%ZIS
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFRFR1   7281     printed  Sep 23, 2025@20:24:33                                                                                                                                                                                                    Page 2
DGPFRFR1  ;ALB/RBS - PRF ASSIGNMENTS DUE REVIEW REPORT CONT. ; 5/21/03 4:40pm
 +1       ;;5.3;Registration;**425**;Aug 13, 1993
 +2       ;
 +3       ;This routine will create the ASSIGNMENTS DUE FOR REVIEW REPORT.
 +4       ;This routine will be used to display or print all of the patient
 +5       ; assignments due for Review for Category I and Category II PRF's.
 +6       ;
 +7       ;All sort input was created in routine DGPFRFR.
 +8       ; Input: The following array contains the sort var's:
 +9       ;   DGSORT("DGCAT")  = category reporting on (I, II, or (B)oth)
 +10      ;   DGSORT("DGFLAG") = "A" = (A)ll Flags will be reported on
 +11      ;                    = IEN of a (S)ingle Flag (#26.11)/(#26.15)
 +12      ;                        example:  "1;DGPF(26.15,"
 +13      ;   DGSORT("DGBEG")  = Beginning date to report on
 +14      ;   DGSORT("DGEND")  = Ending date to report on
 +15      ;
 +16      ; Output: Formatted report of Record Flag Assignments due for review.
 +17      ;
 +18      ;- no direct entry
 +19       QUIT 
 +20      ;
START     ; compile and print report
 +1        IF $EXTRACT(IOST)="C"
               DO WAIT^DICD
 +2        NEW DGLIST
 +3        SET DGLIST=$NAME(^TMP("DGPFRFR1",$JOB))
 +4        KILL @DGLIST
 +5        DO LOOP(.DGSORT)
 +6        DO PRINT(.DGSORT,DGLIST)
 +7        DO EXIT
 +8        QUIT 
 +9       ;
LOOP(DGSORT) ;use sort var's for record searching to build list
 +1       ;  Input:
 +2       ;      DGSORT - array of user selected report parameters
 +3       ;
 +4       ; Output:
 +5       ;      ^TMP("DGPFRFA1",$J) - temp global containing report output
 +6       ;
 +7        NEW DGCAT,DGFLAG,DGBEG,DGEND,DGIEN,DGDFN,DGC,DGX,DGQ,DGFG,DGSUB,DGNOW
 +8        SET (DGQ,DGFG)=0
 +9        SET DGX=""
           FOR 
               SET DGX=$ORDER(DGSORT(DGX))
               if DGX=""
                   QUIT 
               SET @DGX=DGSORT(DGX)
 +10      ; 0 = both cat. I,II (National,Local)
           SET DGC=$SELECT(+DGCAT=3:0,1:+DGCAT)
 +11       if DGC
               SET DGC=$SELECT(DGC=1:26.15,1:26.11)
 +12      ;"A"=all flags or "5;DGPF(26.11," is selection
           SET DGFG=$PIECE(DGFLAG,U)
 +13      ; seed var to start at user selected beginning date
           SET DGSUB=DGBEG-1
 +14       FOR 
               SET DGSUB=$ORDER(^DGPF(26.13,"AFREV",DGSUB))
               if DGSUB=""
                   QUIT 
               Begin DoDot:1
 +15               IF DGSUB>DGEND
                       SET DGQ=1
                       QUIT 
 +16               SET DGDFN=""
 +17               FOR 
                       SET DGDFN=$ORDER(^DGPF(26.13,"AFREV",DGSUB,DGDFN))
                       if DGDFN=""
                           QUIT 
                       Begin DoDot:2
 +18                       SET DGIEN=""
 +19                       FOR 
                               SET DGIEN=$ORDER(^DGPF(26.13,"AFREV",DGSUB,DGDFN,DGIEN))
                               if DGIEN=""
                                   QUIT 
                               Begin DoDot:3
 +20      ;status not active
                                   if '$DATA(^DGPF(26.13,"D",DGDFN,1,DGIEN))
                                       QUIT 
 +21      ;flag not found
                                   IF +DGFG
                                       IF '$DATA(^DGPF(26.13,"C",DGDFN,DGFG,DGIEN))
                                           QUIT 
 +22                               DO BLDTMP(.DGSORT,DGDFN,DGIEN,DGLIST)
                               End DoDot:3
                       End DoDot:2
               End DoDot:1
               if DGQ
                   QUIT 
 +23       QUIT 
 +24      ;
BLDTMP(DGSORT,DGDFN,DGIEN,DGLIST) ; list global builder
 +1       ;  Input:
 +2       ;      DGSORT - array of user selected report parameters
 +3       ;      DGDFN  - ien of patient in PATIENT (#2) file
 +4       ;      DGIEN  - ien pointer to PRF ASSIGNMENT (#26.13) file record
 +5       ;
 +6       ; Output:
 +7       ;      ^TMP("DGPFRFA1",$J) - temp global containing report output
 +8       ;
 +9        NEW DGPFA,DGPFAH,DGPFPAT,DGPTR,DGINIT,DGCATG
 +10       NEW DGLINE,DGNAME,DGREV,DGFG,DGNOT,DGYN
 +11       SET (DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV,DGNOT,DGYN)=""
 +12       KILL DGPFA,DGPFAH,DGPFPAT
 +13      ;retrieve a single assign record
 +14       if '$$GETASGN^DGPFAA(DGIEN,.DGPFA)
               QUIT 
 +15      ;not category selected
           IF +DGC
               IF $PIECE(DGPFA("FLAG"),U)'[+DGC
                   QUIT 
 +16      ;retrieve initial history assign record
 +17       if '$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH)
               QUIT 
 +18      ;-- get 'initial assignment' date
 +19       SET DGPFAH("INITASSIGN")=$GET(DGPFAH("ASSIGNDT"))
 +20       if 'DGPFAH("INITASSIGN")
               QUIT 
 +21       if '$$GETPAT^DGPFUT2(DGDFN,.DGPFPAT)
               QUIT 
 +22       SET DGCATG=$SELECT($PIECE(DGPFA("FLAG"),U)[26.15:1,1:2)
 +23       SET DGFG=$PIECE(DGPFA("FLAG"),U,2)
 +24       SET DGNAME=DGPFPAT("NAME")
 +25       SET DGINIT=$$FDATE^VALM1(+DGPFAH("INITASSIGN"))
 +26       IF +DGPFA("REVIEWDT")
               Begin DoDot:1
 +27               SET DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
 +28      ;past due indicator
                   IF +DGPFA("REVIEWDT")<DGNOW
                       SET DGREV=DGREV_" *"
 +29      ; calulate the notification date
 +30               SET DGNOT=$$NOTIFYDT^DGPFAA3($PIECE(DGPFA("FLAG"),U),$PIECE(DGPFA("REVIEWDT"),U))
 +31               SET DGYN=$SELECT($DATA(^DGPF(26.13,"ANDAT",DGNOT,DGIEN)):"NO",1:"YES")
               End DoDot:1
 +32      IF '$TEST
               SET (DGREV,DGNOT,DGYN)="N/A"
 +33       SET DGLINE=DGPFPAT("SSN")_U_DGINIT_U_DGREV_U_DGYN
 +34       SET @DGLIST@(DGCATG,DGFG,DGNAME,DGDFN)=DGLINE
 +35       KILL DGPFA,DGPFAH,DGPFPAT
 +36       QUIT 
 +37      ;
PRINT(DGSORT,DGLIST) ;output report
 +1       ;  Input:
 +2       ;      DGSORT - array of user selected report parameters
 +3       ;
 +4       ; Output: Formated report to user selected device
 +5       ;
 +6        NEW DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGQ,DGPAGE,DGDT,DGCNT,DGOFG,X,Y,DGGRAND,DGLINE
 +7        SET (DGCNT,DGQ,DGPAGE,DGGRAND)=0
           SET $PIECE(DGLINE,"-",80)=""
 +8        SET DGDT=$PIECE($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
 +9        IF $ORDER(@DGLIST@(""))=""
               Begin DoDot:1
 +10               SET DGCAT=+DGSORT("DGCAT")
 +11               SET DGFG=$SELECT(DGSORT("DGFLAG")="A":"(A)ll Flags",1:$PIECE(DGSORT("DGFLAG"),U,2))
 +12               DO HEAD
 +13               WRITE !!,"   >>> No Record Flag Assignments were found using the report criteria."
               End DoDot:1
               QUIT 
 +14      ; loop and print report
 +15       SET (DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGOFG)=""
 +16       FOR 
               SET DGCAT=$ORDER(@DGLIST@(DGCAT))
               if DGCAT=""
                   QUIT 
               Begin DoDot:1
 +17               FOR 
                       SET DGFG=$ORDER(@DGLIST@(DGCAT,DGFG))
                       if DGFG=""
                           QUIT 
                       Begin DoDot:2
 +18                       IF DGFG'=DGOFG
                               Begin DoDot:3
 +19                               if DGCNT
                                       DO SUB(.DGCNT,1)
 +20                               DO HEAD
 +21                               SET DGOFG=DGFG
                                   SET DGCNT=0
                               End DoDot:3
 +22                       FOR 
                               SET DGNAM=$ORDER(@DGLIST@(DGCAT,DGFG,DGNAM))
                               if DGNAM=""
                                   QUIT 
                               Begin DoDot:3
 +23                               FOR 
                                       SET DGDFN=$ORDER(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN))
                                       if DGDFN=""
                                           QUIT 
                                       Begin DoDot:4
 +24                                       SET DGCNT=DGCNT+1
                                           SET DGCNT(DGCAT)=$GET(DGCNT(DGCAT))+1
 +25                                       if $Y>(IOSL-4)
                                               DO HEAD
 +26                                       if DGQ
                                               QUIT 
 +27                                       SET DGSTR=$GET(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN))
 +28                                       WRITE !,$EXTRACT(DGNAM,1,20),?22,$PIECE(DGSTR,U),?33,$PIECE(DGSTR,U,2),?43,$PIECE(DGSTR,U,3),?60,$PIECE(DGSTR,U,4)
                                       End DoDot:4
                                       if DGQ
                                           QUIT 
                               End DoDot:3
                               if DGQ
                                   QUIT 
                       End DoDot:2
                       if DGQ
                           QUIT 
 +29               if DGQ
                       QUIT 
 +30               IF DGCNT
                       Begin DoDot:2
 +31                       DO SUB(.DGCNT,1)
 +32      ;only if (A)ll flags
                           if DGSORT("DGFLAG")="A"
                               DO SUB(.DGCNT,2)
 +33                       SET DGOFG=""
                           SET DGCNT=0
                       End DoDot:2
               End DoDot:1
               if DGQ
                   QUIT 
 +34      ;
 +35      ;Shutdown if stop task requested
 +36       IF DGQ
               if $DATA(ZTQUEUED)
                   WRITE !!,"REPORT STOPPED AT USER REQUEST"
               QUIT 
 +37      ;
 +38      ; Grand totals (B)oth Categories
           IF +DGSORT("DGCAT")=3
               Begin DoDot:1
 +39               SET DGCAT=3
                   SET DGFG="All Flags"
                   SET DGGRAND=1
 +40               DO HEAD
 +41               WRITE !!,"REPORT SUMMARY:",!,"---------------"
 +42               FOR DGCAT=1,2,3
                       Begin DoDot:2
 +43                       if DGCAT'=3
                               SET DGCNT(3)=$GET(DGCNT(3))+$GET(DGCNT(DGCAT))
 +44                       if DGCAT=3
                               WRITE !?46,"-------"
 +45                       WRITE !,"Total Review Assignments for Category "
 +46                       WRITE $SELECT(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":"
 +47                       WRITE ?47,$JUSTIFY(+$GET(DGCNT(DGCAT)),6)
                       End DoDot:2
               End DoDot:1
 +48      ;
 +49       WRITE !!,"<End of Report>"
 +50       QUIT 
 +51      ;
PAUSE(DGQ) ; pause screen display
 +1       ;  Input:
 +2       ;      DGQ - var used to quit report processing to user CRT
 +3       ; Output:
 +4       ;      DGQ - passed by reference - 0 = Continue, 1 = Quit
 +5       ;
 +6        IF $GET(DGPAGE)>0
               IF $EXTRACT(IOST,1,2)="C-"
                   KILL DIR
                   SET DIR(0)="E"
                   DO ^DIR
                   KILL DIR
                   if +Y=0
                       SET DGQ=1
 +7        QUIT 
 +8       ;
SUB(CNT,TYP) ; print sub-totals
 +1       ;  Input:
 +2       ;      CNT - count of records printed
 +3       ;      TYP - indicator of which total count is being printed
 +4       ; Output: Write lines of Sub-Totals and Totals per Flag and Category
 +5       ;
 +6        NEW DGTYPE,DGCOUNT
 +7        SET DGTYPE=$SELECT(TYP=1:"Flag",2:"Category "_$SELECT(DGCAT=1:"I",1:"II"))
 +8        SET DGCOUNT=$SELECT(TYP=1:CNT,1:DGCNT(DGCAT))
 +9        if TYP=1
               WRITE !
 +10       WRITE !,"Total Review Assignments for "_DGTYPE_":  ",DGCOUNT
 +11       if TYP=1
               WRITE !,"Note:  "" * "" indicates that review date is past due",!
 +12       QUIT 
 +13      ;
HEAD      ;Print/Display page header
 +1        IF $DATA(ZTQUEUED)
               IF $$S^%ZTLOAD
                   SET (ZTSTOP,DGQ)=1
                   QUIT 
 +2        DO PAUSE(.DGQ)
 +3        if DGQ
               QUIT 
 +4        if '($EXTRACT(IOST,1,2)'="C-"&'DGPAGE)
               WRITE @IOF
 +5        SET DGPAGE=$GET(DGPAGE)+1
 +6        WRITE !?22,"PATIENT RECORD FLAGS"
 +7        WRITE !?16,"ASSIGNMENTS DUE FOR REVIEW REPORT",?70,"Page: ",$GET(DGPAGE)
 +8        WRITE !?16,"---------------------------------",?51,"Printed: ",DGDT
 +9        WRITE !?2,"CATEGORY: "_$SELECT($GET(DGCAT)=1:"Category I (National)",$GET(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
 +10       WRITE !,"DATE RANGE: ",$$FDATE^VALM1($GET(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($GET(DGSORT("DGEND")))
 +11       WRITE !?1,"FLAG NAME: ",$GET(DGFG),!
 +12       IF DGGRAND
               WRITE DGLINE
               QUIT 
 +13       WRITE !,"PATIENT NAME",?22,"SSN",?33,"ASSIGNED",?43,"REVIEW DT",?54,"NOTIFICATION SENT"
 +14       WRITE !,"--------------------",?22,"---------",?33,"--------",?43,"---------",?54,"-----------------"
 +15       QUIT 
 +16      ;
EXIT      ;
 +1        IF $DATA(ZTQUEUED)
               SET ZTREQ="@"
 +2        KILL @DGLIST
 +3        IF '$DATA(ZTQUEUED)
               Begin DoDot:1
 +4                KILL %ZIS,POP
 +5                DO ^%ZISC
                   DO HOME^%ZIS
               End DoDot:1
 +6        QUIT