DGPFRAB1 ;ALB/RBS - PRF APPROVED BY REPORT CONT. ; 6/4/04 11:17am
;;5.3;Registration;**554**;Aug 13, 1993
;
;This routine will be used to display or print all Patient Record
;Flag Assignment History Actions for the Approved By Person who
;authorized the new entry or edit of an assignment to the patient.
;
; Input: The following sort array contains the report parameters:
; 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)
;
; Output: A formatted report of the Approved By person's assignments
; that they have authorized to be assigned to a patient.
;
;- no direct entry
QUIT
;
START ; compile and print report
I $E(IOST)="C" D WAIT^DICD
N DGLIST ;temp global name used for report list
S DGLIST=$NA(^TMP("DGPFRAB1",$J))
K @DGLIST
D LOOP(.DGSORT,DGLIST)
D PRINT(.DGSORT,DGLIST)
K @DGLIST
D EXIT
Q
;
LOOP(DGSORT,DGLIST) ;use sort var's for record searching to build list
; Input:
; DGSORT - array of user selected report parameters
; DGLIST - temp global name
;
; Output:
; ^TMP("DGPFRAB1",$J) - temp global containing report output
;
N DGABIEN ;approved by person ien
N DGAIEN ;approved by history assignment ien
N DGAPROV ;approved by sort
N DGBEG ;sort beginning date
N DGC ;var used to check which category is being reported on
N DGCAT ;sort flag category
N DGCATG ;category 1 or 2
N DGEND ;sort ending date
N DGHIEN ;history assignment ien
N DGPFA ;assignment data array
N DGPFAH ;assignment history data array
N DGQ ;quit var
N DGSTAT ;status of assignment
N DGSTATUS ;sort status
N DGSUB ;loop flag
N DGX ;loop var
;
; setup variables equal to user input parameter subscripts
; "DGAPROV", "DGCAT", "DGSTATUS", "DGBEG", "DGEND"
S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX)
;
S DGABIEN=+DGAPROV ; if 0, then All Approved By sort
S DGC=$S(+DGCAT=3:0,1:+DGCAT) ; 0=Both categories sort
S:DGC DGC=$S(DGC=1:26.15,1:26.11) ; specific file
S DGSTAT=+DGSTATUS ; assignments status to report on
S:DGSTAT=2 DGSTAT=0 ; inactive status value is '0'
;
; seed var to start at user selected values
S (DGQ,DGSUB)=0
S DGSUB=DGBEG-1
;
; loop history assignment d/t & approve by x-ref file
F S DGSUB=$O(^DGPF(26.14,"D",DGSUB)) Q:DGSUB="" D Q:DGQ
. I DGSUB>(DGEND+.999999999) S DGQ=1 Q
. S DGAIEN=""
. S:DGABIEN DGAIEN=DGABIEN-1 ;seed var to start before selection
. F S DGAIEN=$O(^DGPF(26.14,"D",DGSUB,DGAIEN)) Q:DGAIEN="" D
.. I DGABIEN,(DGAIEN>DGABIEN) Q
.. S DGHIEN=""
.. F S DGHIEN=$O(^DGPF(26.14,"D",DGSUB,DGAIEN,DGHIEN)) Q:DGHIEN="" D
...K DGPFAH
...Q:'$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH)
...I DGABIEN,(+DGPFAH("APPRVBY")'=DGABIEN) Q
...K DGPFA
...Q:'$$GETASGN^DGPFAA(+DGPFAH("ASSIGN"),.DGPFA)
...I DGC,DGPFA("FLAG")'[DGC Q ;not correct category
...I DGSTAT'=3,+DGPFA("STATUS")'=DGSTAT Q ;not correct status
...S DGCATG=$S(DGPFA("FLAG")[26.15:1,1:2)
...D BLDTMP(.DGPFA,.DGPFAH,DGHIEN,DGCATG,DGLIST)
Q
;
BLDTMP(DGPFA,DGPFAH,DGHIEN,DGCATG,DGLIST) ; list global builder
; Input:
; DGPFA - array of assignment record data
; DGPFAH - array of assignment history record data
; DGHIEN - ien to PRF ASSIGNMENT HISTORY (#26.14) file record
; DGCATG - category of flag 1=National, 2=Local
; DGLIST - temp global name used for report list
;
; Output:
; ^TMP("DGPFRFA1",$J) - temp global containing report output
;
N DG1,DG2 ;subscript var's
N DGACTDT ;initial entry date
N DGDFN ;pointer to patient being reported on
N DGFGNM ;flag name
N DGLINE ;report detail line
N DGPAT ;array of patient demographics
N DGPNM ;patient name
N DGREV ;review date
;
; get patient demographics
S DGDFN=$P(DGPFA("DFN"),U)
K DGPAT
Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT)
S DGPNM=DGPAT("NAME")
S:DGPNM']"" DGPNM="MISSING PATIENT NAME"
S DGFGNM=$P(DGPFA("FLAG"),U,2)
S:DGFGNM']"" DGFGNM="MISSING FLAG NAME"
S DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT"))
I +DGPFA("REVIEWDT") D
.S DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
E S DGREV="N/A"
S DGLINE=DGPAT("SSN")_U_$P(DGPFAH("ACTION"),U,2)_U_DGACTDT_U_DGREV_U_$P(DGPFA("STATUS"),U,2)
; setup subscripts -
; - Approved By Name, IEN, Cat, Flag Name, Pat Name, DFN, History IEN
S DG1=$P(DGPFAH("APPRVBY"),U,2),DG2=$P(DGPFAH("APPRVBY"),U)
S @DGLIST@(DG1,DG2,DGCATG,DGFGNM,DGPNM,DGDFN,DGHIEN)=DGLINE
Q
;
PRINT(DGSORT,DGLIST) ;output report
; Input:
; DGSORT - array of user selected report parameters
; DGLIST - temp global name used for report list
;
; Output: Formatted report to user selected device
;
N DGAPNM ;approved by name
N DGCAT ;flag category
N DGCNT ;counter of detail lines
N DGDFN ;ien of patient
N DGDT ;date time report printed
N DGFG ;flag name
N DGIEN ;approved by ien
N DGLINE ;string of hyphens (80) for report header format
N DGLN ;loop var
N DGNAM ;patient name
N DGOCAT ;category switch flag
N DGODFN ;loop var flag
N DGOFG ;name switch flag
N DGOIEN ;ien switch flag
N DGPAGE ;page counter
N DGQ ;quit flag
N DGSTR ;string of detail line to display
N X,Y
;
S (DGCNT,DGQ,DGPAGE)=0,$P(DGLINE,"-",81)=""
S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
;
I $O(@DGLIST@(""))="" D Q
. D HEAD
. W !!," >>> No Record Flag Assignments were found using the report criteria.",!
;
; loop and print report
S (DGIEN,DGOIEN,DGAPNM,DGCAT,DGOCAT,DGFG,DGOFG,DGNAM,DGDFN,DGODFN,DGLN,DGSTR)=""
D HEAD
F S DGAPNM=$O(@DGLIST@(DGAPNM)) Q:DGAPNM="" D Q:DGQ
. F S DGIEN=$O(@DGLIST@(DGAPNM,DGIEN)) Q:DGIEN="" D Q:DGQ
. . I $Y>(IOSL-8) D PAUSE(.DGQ) Q:DGQ D HEAD,HEAD1 S DGOIEN=DGIEN
. . I DGOIEN'=DGIEN S DGOIEN=DGIEN W:DGCNT ! D HEAD1
. . F S DGCAT=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT)) Q:DGCAT="" D Q:DGQ
. . . F S DGFG=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG)) Q:DGFG="" D Q:DGQ
. . . . I $Y>(IOSL-8) D PAUSE(.DGQ) Q:DGQ D HEAD,HEAD1,HEAD2 S DGOFG=DGFG
. . . . I DGOFG'=DGFG W:DGOFG]"" !! D HEAD2 S DGOFG=DGFG
. . . . ; print patient detail line
. . . . D PRNTPAT
. ; reset var's to pop header's
. S (DGOIEN,DGOCAT,DGOFG)=""
;
;Shutdown if stop task requested
I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
;
W !!,"<End of Report>"
Q
;
PRNTPAT ; loop and print all patients for flag
;
S DGODFN=""
F S DGNAM=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM)) Q:DGNAM="" D Q:DGQ
. F S DGDFN=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN="" D Q:DGQ
. . F S DGLN=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN,DGLN)) Q:DGLN="" D Q:DGQ
. . . I $Y>(IOSL-3) D PAUSE(.DGQ) Q:DGQ D HEAD,HEAD1,HEAD2 S DGODFN=""
. . . S DGSTR=$G(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN,DGLN))
. . . W !
. . . I DGODFN'=DGDFN S DGODFN=DGDFN D ;only print name once
. . . . W $E(DGNAM,1,16),?18,$P(DGSTR,U)
. . . W ?30,$P(DGSTR,U,2),?48,$P(DGSTR,U,3),?60,$P(DGSTR,U,4),?71,$P(DGSTR,U,5)
. . . S DGCNT=DGCNT+1
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
;
HEAD ;Print/Display page header
;
I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
;
S DGPAGE=$G(DGPAGE)+1
W !?25,"PATIENT RECORD FLAGS"
W !?20,"ASSIGNMENTS APPROVED BY REPORT",?68,"Page: ",$G(DGPAGE)
W !,"Date Range: ",$$FDATE^VALM1(DGSORT("DGBEG"))_" to "_$$FDATE^VALM1(DGSORT("DGEND"))
W ?50,"Printed: ",DGDT
W !,DGLINE
Q
;
HEAD1 W !!,"Approved By: ",DGAPNM
Q
;
HEAD2 W !,"Flag Name: ",$G(DGFG)," - ",$S(+DGCAT=1:"Category I (National)",1:"Category II (Local)")
;
W !!,"PATIENT",?18,"SSN",?30,"ACTION",?48,"ACTION DT",?60,"REVIEW DT",?71,"STATUS"
W !,"================",?18,"==========",?30,"================",?48,"=========",?60,"=========",?71,"========="
Q
;
EXIT ;
I $D(ZTQUEUED) S ZTREQ="@"
I '$D(ZTQUEUED) D
. K %ZIS,POP
. D ^%ZISC,HOME^%ZIS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFRAB1 8763 printed Sep 23, 2025@20:24:26 Page 2
DGPFRAB1 ;ALB/RBS - PRF APPROVED BY REPORT CONT. ; 6/4/04 11:17am
+1 ;;5.3;Registration;**554**;Aug 13, 1993
+2 ;
+3 ;This routine will be used to display or print all Patient Record
+4 ;Flag Assignment History Actions for the Approved By Person who
+5 ;authorized the new entry or edit of an assignment to the patient.
+6 ;
+7 ; Input: The following sort array contains the report parameters:
+8 ; DGSORT("DGAPROV") = pointer to NEW PERSON (#200) file^Person Name
+9 ; or
+10 ; = "A" = All approved by persons
+11 ; DGSORT("DGCAT") = CATEGORY
+12 ; 1^Category I (National)
+13 ; 2^Category II (Local)
+14 ; 3^Both
+15 ; DGSORT("DGSTATUS") = Assignment Status to report on
+16 ; 1^Active
+17 ; 2^Inactive
+18 ; 3^Both
+19 ; DGSORT("DGBEG") = BEGINNING DATE (internal FileMan date)
+20 ; DGSORT("DGEND") = ENDING DATE (internal FileMan date)
+21 ;
+22 ; Output: A formatted report of the Approved By person's assignments
+23 ; that they have authorized to be assigned to a patient.
+24 ;
+25 ;- no direct entry
+26 QUIT
+27 ;
START ; compile and print report
+1 IF $EXTRACT(IOST)="C"
DO WAIT^DICD
+2 ;temp global name used for report list
NEW DGLIST
+3 SET DGLIST=$NAME(^TMP("DGPFRAB1",$JOB))
+4 KILL @DGLIST
+5 DO LOOP(.DGSORT,DGLIST)
+6 DO PRINT(.DGSORT,DGLIST)
+7 KILL @DGLIST
+8 DO EXIT
+9 QUIT
+10 ;
LOOP(DGSORT,DGLIST) ;use sort var's for record searching to build list
+1 ; Input:
+2 ; DGSORT - array of user selected report parameters
+3 ; DGLIST - temp global name
+4 ;
+5 ; Output:
+6 ; ^TMP("DGPFRAB1",$J) - temp global containing report output
+7 ;
+8 ;approved by person ien
NEW DGABIEN
+9 ;approved by history assignment ien
NEW DGAIEN
+10 ;approved by sort
NEW DGAPROV
+11 ;sort beginning date
NEW DGBEG
+12 ;var used to check which category is being reported on
NEW DGC
+13 ;sort flag category
NEW DGCAT
+14 ;category 1 or 2
NEW DGCATG
+15 ;sort ending date
NEW DGEND
+16 ;history assignment ien
NEW DGHIEN
+17 ;assignment data array
NEW DGPFA
+18 ;assignment history data array
NEW DGPFAH
+19 ;quit var
NEW DGQ
+20 ;status of assignment
NEW DGSTAT
+21 ;sort status
NEW DGSTATUS
+22 ;loop flag
NEW DGSUB
+23 ;loop var
NEW DGX
+24 ;
+25 ; setup variables equal to user input parameter subscripts
+26 ; "DGAPROV", "DGCAT", "DGSTATUS", "DGBEG", "DGEND"
+27 SET DGX=""
FOR
SET DGX=$ORDER(DGSORT(DGX))
if DGX=""
QUIT
SET @DGX=DGSORT(DGX)
+28 ;
+29 ; if 0, then All Approved By sort
SET DGABIEN=+DGAPROV
+30 ; 0=Both categories sort
SET DGC=$SELECT(+DGCAT=3:0,1:+DGCAT)
+31 ; specific file
if DGC
SET DGC=$SELECT(DGC=1:26.15,1:26.11)
+32 ; assignments status to report on
SET DGSTAT=+DGSTATUS
+33 ; inactive status value is '0'
if DGSTAT=2
SET DGSTAT=0
+34 ;
+35 ; seed var to start at user selected values
+36 SET (DGQ,DGSUB)=0
+37 SET DGSUB=DGBEG-1
+38 ;
+39 ; loop history assignment d/t & approve by x-ref file
+40 FOR
SET DGSUB=$ORDER(^DGPF(26.14,"D",DGSUB))
if DGSUB=""
QUIT
Begin DoDot:1
+41 IF DGSUB>(DGEND+.999999999)
SET DGQ=1
QUIT
+42 SET DGAIEN=""
+43 ;seed var to start before selection
if DGABIEN
SET DGAIEN=DGABIEN-1
+44 FOR
SET DGAIEN=$ORDER(^DGPF(26.14,"D",DGSUB,DGAIEN))
if DGAIEN=""
QUIT
Begin DoDot:2
+45 IF DGABIEN
IF (DGAIEN>DGABIEN)
QUIT
+46 SET DGHIEN=""
+47 FOR
SET DGHIEN=$ORDER(^DGPF(26.14,"D",DGSUB,DGAIEN,DGHIEN))
if DGHIEN=""
QUIT
Begin DoDot:3
+48 KILL DGPFAH
+49 if '$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH)
QUIT
+50 IF DGABIEN
IF (+DGPFAH("APPRVBY")'=DGABIEN)
QUIT
+51 KILL DGPFA
+52 if '$$GETASGN^DGPFAA(+DGPFAH("ASSIGN"),.DGPFA)
QUIT
+53 ;not correct category
IF DGC
IF DGPFA("FLAG")'[DGC
QUIT
+54 ;not correct status
IF DGSTAT'=3
IF +DGPFA("STATUS")'=DGSTAT
QUIT
+55 SET DGCATG=$SELECT(DGPFA("FLAG")[26.15:1,1:2)
+56 DO BLDTMP(.DGPFA,.DGPFAH,DGHIEN,DGCATG,DGLIST)
End DoDot:3
End DoDot:2
End DoDot:1
if DGQ
QUIT
+57 QUIT
+58 ;
BLDTMP(DGPFA,DGPFAH,DGHIEN,DGCATG,DGLIST) ; list global builder
+1 ; Input:
+2 ; DGPFA - array of assignment record data
+3 ; DGPFAH - array of assignment history record data
+4 ; DGHIEN - ien to PRF ASSIGNMENT HISTORY (#26.14) file record
+5 ; DGCATG - category of flag 1=National, 2=Local
+6 ; DGLIST - temp global name used for report list
+7 ;
+8 ; Output:
+9 ; ^TMP("DGPFRFA1",$J) - temp global containing report output
+10 ;
+11 ;subscript var's
NEW DG1,DG2
+12 ;initial entry date
NEW DGACTDT
+13 ;pointer to patient being reported on
NEW DGDFN
+14 ;flag name
NEW DGFGNM
+15 ;report detail line
NEW DGLINE
+16 ;array of patient demographics
NEW DGPAT
+17 ;patient name
NEW DGPNM
+18 ;review date
NEW DGREV
+19 ;
+20 ; get patient demographics
+21 SET DGDFN=$PIECE(DGPFA("DFN"),U)
+22 KILL DGPAT
+23 if '$$GETPAT^DGPFUT2(DGDFN,.DGPAT)
QUIT
+24 SET DGPNM=DGPAT("NAME")
+25 if DGPNM']""
SET DGPNM="MISSING PATIENT NAME"
+26 SET DGFGNM=$PIECE(DGPFA("FLAG"),U,2)
+27 if DGFGNM']""
SET DGFGNM="MISSING FLAG NAME"
+28 SET DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT"))
+29 IF +DGPFA("REVIEWDT")
Begin DoDot:1
+30 SET DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
End DoDot:1
+31 IF '$TEST
SET DGREV="N/A"
+32 SET DGLINE=DGPAT("SSN")_U_$PIECE(DGPFAH("ACTION"),U,2)_U_DGACTDT_U_DGREV_U_$PIECE(DGPFA("STATUS"),U,2)
+33 ; setup subscripts -
+34 ; - Approved By Name, IEN, Cat, Flag Name, Pat Name, DFN, History IEN
+35 SET DG1=$PIECE(DGPFAH("APPRVBY"),U,2)
SET DG2=$PIECE(DGPFAH("APPRVBY"),U)
+36 SET @DGLIST@(DG1,DG2,DGCATG,DGFGNM,DGPNM,DGDFN,DGHIEN)=DGLINE
+37 QUIT
+38 ;
PRINT(DGSORT,DGLIST) ;output report
+1 ; Input:
+2 ; DGSORT - array of user selected report parameters
+3 ; DGLIST - temp global name used for report list
+4 ;
+5 ; Output: Formatted report to user selected device
+6 ;
+7 ;approved by name
NEW DGAPNM
+8 ;flag category
NEW DGCAT
+9 ;counter of detail lines
NEW DGCNT
+10 ;ien of patient
NEW DGDFN
+11 ;date time report printed
NEW DGDT
+12 ;flag name
NEW DGFG
+13 ;approved by ien
NEW DGIEN
+14 ;string of hyphens (80) for report header format
NEW DGLINE
+15 ;loop var
NEW DGLN
+16 ;patient name
NEW DGNAM
+17 ;category switch flag
NEW DGOCAT
+18 ;loop var flag
NEW DGODFN
+19 ;name switch flag
NEW DGOFG
+20 ;ien switch flag
NEW DGOIEN
+21 ;page counter
NEW DGPAGE
+22 ;quit flag
NEW DGQ
+23 ;string of detail line to display
NEW DGSTR
+24 NEW X,Y
+25 ;
+26 SET (DGCNT,DGQ,DGPAGE)=0
SET $PIECE(DGLINE,"-",81)=""
+27 SET DGDT=$PIECE($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
+28 ;
+29 IF $ORDER(@DGLIST@(""))=""
Begin DoDot:1
+30 DO HEAD
+31 WRITE !!," >>> No Record Flag Assignments were found using the report criteria.",!
End DoDot:1
QUIT
+32 ;
+33 ; loop and print report
+34 SET (DGIEN,DGOIEN,DGAPNM,DGCAT,DGOCAT,DGFG,DGOFG,DGNAM,DGDFN,DGODFN,DGLN,DGSTR)=""
+35 DO HEAD
+36 FOR
SET DGAPNM=$ORDER(@DGLIST@(DGAPNM))
if DGAPNM=""
QUIT
Begin DoDot:1
+37 FOR
SET DGIEN=$ORDER(@DGLIST@(DGAPNM,DGIEN))
if DGIEN=""
QUIT
Begin DoDot:2
+38 IF $Y>(IOSL-8)
DO PAUSE(.DGQ)
if DGQ
QUIT
DO HEAD
DO HEAD1
SET DGOIEN=DGIEN
+39 IF DGOIEN'=DGIEN
SET DGOIEN=DGIEN
if DGCNT
WRITE !
DO HEAD1
+40 FOR
SET DGCAT=$ORDER(@DGLIST@(DGAPNM,DGIEN,DGCAT))
if DGCAT=""
QUIT
Begin DoDot:3
+41 FOR
SET DGFG=$ORDER(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG))
if DGFG=""
QUIT
Begin DoDot:4
+42 IF $Y>(IOSL-8)
DO PAUSE(.DGQ)
if DGQ
QUIT
DO HEAD
DO HEAD1
DO HEAD2
SET DGOFG=DGFG
+43 IF DGOFG'=DGFG
if DGOFG]""
WRITE !!
DO HEAD2
SET DGOFG=DGFG
+44 ; print patient detail line
+45 DO PRNTPAT
End DoDot:4
if DGQ
QUIT
End DoDot:3
if DGQ
QUIT
End DoDot:2
if DGQ
QUIT
+46 ; reset var's to pop header's
+47 SET (DGOIEN,DGOCAT,DGOFG)=""
End DoDot:1
if DGQ
QUIT
+48 ;
+49 ;Shutdown if stop task requested
+50 IF DGQ
if $DATA(ZTQUEUED)
WRITE !!,"REPORT STOPPED AT USER REQUEST"
QUIT
+51 ;
+52 WRITE !!,"<End of Report>"
+53 QUIT
+54 ;
PRNTPAT ; loop and print all patients for flag
+1 ;
+2 SET DGODFN=""
+3 FOR
SET DGNAM=$ORDER(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM))
if DGNAM=""
QUIT
Begin DoDot:1
+4 FOR
SET DGDFN=$ORDER(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN))
if DGDFN=""
QUIT
Begin DoDot:2
+5 FOR
SET DGLN=$ORDER(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN,DGLN))
if DGLN=""
QUIT
Begin DoDot:3
+6 IF $Y>(IOSL-3)
DO PAUSE(.DGQ)
if DGQ
QUIT
DO HEAD
DO HEAD1
DO HEAD2
SET DGODFN=""
+7 SET DGSTR=$GET(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN,DGLN))
+8 WRITE !
+9 ;only print name once
IF DGODFN'=DGDFN
SET DGODFN=DGDFN
Begin DoDot:4
+10 WRITE $EXTRACT(DGNAM,1,16),?18,$PIECE(DGSTR,U)
End DoDot:4
+11 WRITE ?30,$PIECE(DGSTR,U,2),?48,$PIECE(DGSTR,U,3),?60,$PIECE(DGSTR,U,4),?71,$PIECE(DGSTR,U,5)
+12 SET DGCNT=DGCNT+1
End DoDot:3
if DGQ
QUIT
End DoDot:2
if DGQ
QUIT
End DoDot:1
if DGQ
QUIT
+13 QUIT
+14 ;
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 ;
HEAD ;Print/Display page header
+1 ;
+2 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (ZTSTOP,DGQ)=1
QUIT
+3 if '($EXTRACT(IOST,1,2)'="C-"&'DGPAGE)
WRITE @IOF
+4 ;
+5 SET DGPAGE=$GET(DGPAGE)+1
+6 WRITE !?25,"PATIENT RECORD FLAGS"
+7 WRITE !?20,"ASSIGNMENTS APPROVED BY REPORT",?68,"Page: ",$GET(DGPAGE)
+8 WRITE !,"Date Range: ",$$FDATE^VALM1(DGSORT("DGBEG"))_" to "_$$FDATE^VALM1(DGSORT("DGEND"))
+9 WRITE ?50,"Printed: ",DGDT
+10 WRITE !,DGLINE
+11 QUIT
+12 ;
HEAD1 WRITE !!,"Approved By: ",DGAPNM
+1 QUIT
+2 ;
HEAD2 WRITE !,"Flag Name: ",$GET(DGFG)," - ",$SELECT(+DGCAT=1:"Category I (National)",1:"Category II (Local)")
+1 ;
+2 WRITE !!,"PATIENT",?18,"SSN",?30,"ACTION",?48,"ACTION DT",?60,"REVIEW DT",?71,"STATUS"
+3 WRITE !,"================",?18,"==========",?30,"================",?48,"=========",?60,"=========",?71,"========="
+4 QUIT
+5 ;
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+3 KILL %ZIS,POP
+4 DO ^%ZISC
DO HOME^%ZIS
End DoDot:1
+5 QUIT
