Routine: DGPFRAL1

DGPFRAL1 ;ALB/RBS - PRF ACTION NOT LINKED REPORT CONT. ; 10/12/05 2:48pm

 ;;5.3;Registration;**554,650,892,960**;Aug 13, 1993;Build 22

 ;     Last Edited: SHRPE/SGM - July 9, 2018 15:55

 ; ICR# TYPE DESCRIPTION

 ;----- ---- ---------------------

 ;2171  Sup  $$STA^XUAF4

 ;10024 Sup  WAIT^DICD

 ;10063 Sup  $$S^%ZTLOAD

 ;10086 Sup  HOME^%ZIS

 ;10089 Sup  ^%ZISC

 ;10103 Sup  ^XLFDT: $$FMTE, $$NOW

 ;10112 Sup  $$SITE^VASITE

 ;This routine will be used to display or print all of the patient

 ;assignment history records that are not linked to a progress note.

 ; INPUT:  DGSORT() - see comments at the top of routine DGPFRAL for

 ;         explanation of DGSORT array

 ; Output:  A formatted report of patient Assignment History Actions

 ;          that are not linked to a TIU Progress Note.

 ;- no direct entry

 QUIT

START ; compile and print report

 N DGLIST,DGQ,HD,TRM

 D INIT

 D LOOP I 'DGQ D PRINT(.DGSORT,DGLIST)

EXIT ;

 K @DGLIST

 I $D(ZTQUEUED) S ZTREQ="@"

 I 'DGQ,TRM S X=$$E^DGPFUT7 W @IOF

 I 'TRM,$Y>0 W @IOF

LOOP ;use sort var's for record searching to build list

 ;  Input:

 ;      DGSORT - array of user selected report parameters

 ;      DGLIST - temp global name

 ; Output:

 ;      ^TMP("DGPFRAL1",$J) - temp global containing report output

 N DGBEG    ;beginning date

 N DGC      ;var used to check which category is being reported on

 N DGCAT    ;flag category

 N DGCATG   ;category 1 or 2

 N DGCNT    ;flag counter

 N DGDFN    ;pointer to patient being reported on

 N DGDFNLST ;array of dfn's assigned to the flag

 N DGEND    ;ending date

 N DGHIENS  ;array subscripted by assignment history date

 N DGIEN    ;assignment ien

 N DGPAT    ;patient data array

 N DGPFA    ;assignment data array

 N DGSUB    ;loop flag

 N DGX      ;loop var

 ; setup variables equal to user input parameter subscripts

 ;   "DGCAT", "DGBEG", "DGEND"

 S DGX="" F  S DGX=$O(DGSORT(DGX)) Q:DGX=""  S @DGX=DGSORT(DGX)

 S DGC=$S(+DGCAT=3:0,1:+DGCAT)

 S:DGC DGC=$S(DGC=1:26.15,1:26.11)

 N DGI S DGI=0

 ; loop assignment variable pointer flag x-ref file to run report

 S (DGDFN,DGIEN)="",(DGSUB,DGCNT)=0

 F  S DGSUB=$O(^DGPF(26.13,"AFLAG",DGSUB)) Q:DGSUB=""  D  Q:DGQ

 . I DGC,DGSUB'[DGC Q  ;not correct file based on category

 . S DGCATG=$S(DGSUB[26.15:1,1:2)

 . K DGDFNLST

 . S DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST)

 . Q:'DGCNT

 . S DGDFN=""

 . F  S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN=""  D  Q:DGQ

 . . S DGI=1+DGI I '(DGI#200) D CHK Q:DGQ

 . . S DGIEN=$G(DGDFNLST(DGDFN)) Q:DGIEN=""

 . . ; get assignment record

 . . K DGPFA

 . . Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)

 . . ; check if calling site is owner site

 . . Q:'$$ISDIV^DGPFUT($P(DGPFA("OWNER"),U))

 . . ;

 . . ;filter patient when last action is ENTERED IN ERROR

 . . Q:$$ENTINERR(DGIEN)

 . . ;

 . . ;filter for single flag - DG*5.3*960

 . . Q:'$$FLAGNM($P(DGPFA("FLAG"),U))

 . . ;

 . . ;filter on assignment status - DG*5.3*960

 . . Q:'$$STATUS(+DGPFA("STATUS"))

 . . ;

 . . ;action ien array subscripted by assignment history date

 . . K DGHIENS

 . . Q:'$$GETALLDT^DGPFAAH(DGIEN,.DGHIENS)

 . . ; check if any Action's fall within the Begin and End dates

 . . I $P($O(DGHIENS("")),".")'>DGEND&($P($O(DGHIENS(""),-1),".")'<DGBEG) D

 . . . ;delete any action that is not within Begin and End dates

 . . . S DGX=0 F  S DGX=$O(DGHIENS(DGX)) Q:DGX=""  D

 . . . . I $P(DGX,".")<DGBEG!($P(DGX,".")>DGEND) K DGHIENS(DGX)

 . . . Q:'$O(DGHIENS(""))

 . . . ;

 . . . ; get patient demographics

 . . . K DGPAT

 . . . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT)

 . . . ;

 . . . ; call to build temp global

 . . . D BLDTMP(.DGPFA,.DGPAT,.DGHIENS,DGCATG,DGLIST)

BLDTMP(DGPFA,DGPAT,DGHIENS,DGCATG,DGLIST) ; list global builder

 ;  Input:

 ;      DGPFA  - array of assignment record data

 ;      DGPAT  - array of patient demographics

 ;      DGHIENS - array of history action IEN's sorted by d/t

 ;      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 DGACTDT ;initial entry date

 N DGFGNM  ;flag name

 N DGHIEN  ;assignment ien

 N DGLINE  ;report detail line

 N DGLNCNT ;unique subscript counter

 N DGPDFN  ;pointer to patient

 N DGPFAH  ;assignment history record data

 N DGPNM   ;patient name

 N DGFLAG   ;change of assignment flag

 ; Check to see if this was a change of assignment

 S DGFLAG=0

 N DGI S DGI=0

 D FLGXFER

 ; loop all assignment history ien's

 S DGHIEN="",DGLNCNT=0

 F  S DGHIEN=$O(DGHIENS(DGHIEN)) Q:DGHIEN=""  D  Q:DGQ

 . S DGI=DGI+1 I '(DGI#200) D CHK Q:DGQ

 . ;   get assignment history record

 . K DGPFAH

 . Q:'$$GETHIST^DGPFAAH(DGHIENS(DGHIEN),.DGPFAH)

 . Q:+$G(DGPFAH("TIULINK"))  ;  progress note pointer

 . Q:+$G(DGPFAH("ACTION"))=5  ; no ENTERED IN ERROR action

 . S DGACTDT=$$FMTE^XLFDT(+DGPFAH("ASSIGNDT")\1,"2Z")

 . I DGFLAG I +DGPFAH("ASSIGNDT")'>DGFLAG Q  ; if < assignment chg

 . Q:'$$LOCAL()  ;              check local/not local DG*5.3*960

 . S DGPNM=DGPAT("NAME")

 . S:DGPNM']"" DGPNM="MISSING PATIENT NAME"

 . S DGPDFN=$P(DGPFA("DFN"),U)

 . S DGFGNM=$P(DGPFA("FLAG"),U,2)

 . S:DGFGNM']"" DGFGNM="MISSING FLAG NAME"

 . S DGLINE=$E(DGPNM)_$E(DGPAT("SSN"),6,10)_U_$E(DGFGNM,1,17)

 . S DGLINE=DGLINE_U_$P(DGPFAH("ACTION"),U,2)_U_DGACTDT

 . S DGLNCNT=DGLNCNT+1

 . S @DGLIST@(DGCATG,DGFGNM,DGPNM,DGPDFN,DGLNCNT)=DGLINE

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 CAT   ;  flag category

 N OCAT  ;  previous flag category

 N DFN   ;  ien of patient

 N ODFN  ;  previous DFN

 N FLAG  ;  flag name

 N NAM   ;  patient name

 N OFLAG ;  previoous flag name

 N PAGE  ;  page counter

 N REF   ;  $query incrementing variable

 N STR   ;  string of detail line to display

 N I,X,Y,STOP,TOTAL

 S (OCAT,ODFN,OFLAG)=""

 S REF=DGLIST

 S STOP=$TR(REF,")",",")

 S (TOTAL,TOTAL(1),TOTAL(2))=0

 S PAGE=0

 I $O(@DGLIST@(""))="" D  Q

 . D HEAD

 . W !!,"   >>> No Record Flag Assignments were found using the report criteria.",!

. Q

 F I=1:1 S REF=$Q(@REF) Q:REF=""  Q:REF'[STOP  D  Q:DGQ

 . N NL S NL=1 ;  flag to indicate a new line is needed

 . S STR=@REF

 . S CAT=$QS(REF,3),FLAG=$QS(REF,4),NAM=$QS(REF,5),DFN=$QS(REF,6)

 . ; for each flag/pat combination, write flag and pat only once

 . ; however, repeat name/flag at beginning of new page

 . ; do header for each category change

 . I CAT'=OCAT,+OCAT D SUBTOT Q:DGQ

 . I CAT'=OCAT D HEAD S OCAT=CAT

 . I $Y>(IOSL-4) D PAUSE Q:DGQ  D HEAD S ODFN=""

 . I DFN'=ODFN D

 . . W !,$E(NAM,1,18),?20,$P(STR,U),?32,$E($P(STR,U,2),1,17)

 . . S ODFN=DFN,OFLAG=FLAG,NL=0

 . . Q

 . ; - write new flag name

 . I OFLAG'=FLAG S OFLAG=FLAG W !?32,$E($P(STR,U,2),1,17),NL=0

 . ; - write action detail

 . W:NL ! W ?51,$E($P(STR,U,3),1,16),?69,$P(STR,U,4)

 . S TOTAL(CAT)=TOTAL(CAT)+1

. Q

 ;   Last category subtotals did not print

 S OCAT=CAT D SUBTOT

 D CHK

 ;   Print totals if both cat I & II selected

 I 'DGQ,+DGSORT("DGCAT")=3 D

 . I 'TRM,(IOSL-$Y)<10 D HEAD

 . W !!,"REPORT SUMMARY:",!,"---------------"

 . W !,"Total Actions not Linked for Category I:",?48,$J(TOTAL(1),7)

 . W !,"Total Actions not Linked for Category II:",?48,$J(TOTAL(2),7)

 . W !?48,"-------"

 . S X=TOTAL(1)+TOTAL(2)

 . W !,"Total Actions not Linked for Category I & II:",?48,$J(X,7)

. Q

 W !!,"<End of Report>"

 ;-----------------------  PRIVATE SUBROUTINES  -----------------------

CHK ;

 ;   Check is Taskman request to stop

 I 'DGQ,$D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1

 I DGQ,$D(ZTQUEUED) W !!,"REPORT STOPPED AT USER REQUEST",!

ENTINERR(DGIEN) ;

 ;  Is last action ENTERED IN ERROR

 ;  Input:

 ;    DGIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file

 ;  Output:

 ;   Function Value - Return 1 on success, 0 on failure

 N DGPFAH

 I $$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGIEN),.DGPFAH)

 Q +$G(DGPFAH("ACTION"))=5

FLAGNM(FLG) ;

 ;  Is flag = selected flag; DG*5.3*960

 ;  "DGFLG": variable_pointer for flag, else ""

 N SORT S SORT=$P($G(DGSORT("DGFLG")),U,3)

 Q $S('SORT:1,1:SORT=FLG)

FLGXFER ;

 ;   If flag transferred and prior to assignment change date

 ;   then do not rpt missing TIU link

 N X,DGHIEN,DGHACT

 Q:$P($G(DGPFA("ORIGSITE")),U)=$P($G(DGPFA("OWNER")),U)

 S X="Change of flag assignment ownership."

 S DGHIEN=""

 F  S DGHIEN=$O(DGHIENS(DGHIEN)) Q:DGHIEN=""  D

 . S DGHACT=DGHIENS(DGHIEN)

 . I $G(^DGPF(26.14,DGHACT,1,1,0))[X S DGFLAG=$P(DGHIEN,U)

HEAD ;

 ;   Print/Display page header

 N X D CHK Q:DGQ

 I TRM!('TRM&PAGE) W @IOF

 S PAGE=PAGE+1

 S X=$S('$D(CAT):"",+CAT=1:"I (National)",1:"II (Local)")

 F I=1:1:3 W !,HD(I) W:I=2 $J(PAGE,5)

 I PAGE<2 F I=1:1:4 W !,HD(1,I)

 I $D(CAT),CAT'=OCAT F I=1:1:4 W !,HD(2,I) W:I=1 X

INIT ;  initial certain local variables

 N X,BEG,END,FLG,PRT,SP

 S $P(SP," ",80)=""

 S TRM=($E(IOST)="C") I TRM D WAIT^DICD

 S DGLIST=$NA(^TMP("DGPFRAL1",$J)) ;temp global for report

 K @DGLIST

 S DGQ=0

 ;   header display for all pages

 S HD(1)=$E(SP,1,24)_"Patient Record Flags"

 S X="Assignment Action Not Linked To A Progress Note Report"

 S $E(X,68)="Page: "

 S HD(2)=X

 S $P(HD(3),"-",80)=""

 S BEG=$$FMTE^XLFDT(DGSORT("DGBEG"),"5Z")

 S END=$$FMTE^XLFDT(DGSORT("DGEND"),"5Z")

 S PRT=$$FMTE^XLFDT($$NOW^XLFDT,"MP")

 S FLG=$P(DGSORT("DGFLG"),U,2) S:FLG="" FLG="All flags"

 ;   display in header for first page only

 S HD(1,1)="REPORT TYPE: "_$P(DGSORT("DGCAT"),U,2)

 S $E(HD(1,1),47)="STATUS: "_$P(DGSORT("DGSTA"),U,2)

 S HD(1,2)="       FLAG: "_FLG

 S $E(HD(1,2),44)="ACTION BY: "_$P(DGSORT("DGFAC"),U,2)

 S HD(1,3)=" DATE RANGE: "_BEG_" To "_END

 S $E(HD(1,3),46)="PRINTED: "_PRT

 S HD(1,4)=HD(3)

 ;   sub-header display / column header display

 S HD(2,1)="   CATEGORY: "

 S HD(2,2)=""

 S HD(2,3)="PATIENT             SSN         FLAG NAME          ACTION            ACTION DATE"

 S HD(2,4)="------------------  ----------  -----------------  ----------------  -----------"

LOCAL() ;

 ;   Filter is history created locally or not; DG*5.3*960

 ;   expects .DGPFAH; "DGFAC": 1:local;2:other;3:both

 N X,LOC,SORT,TMP

 S SORT=+$G(DGSORT("DGFAC")) I SORT=3 Q 1

 F X="APPRVBY","ENTERBY","ORIGFAC" S TMP(X)=$G(DGPFAH(X))

 S LOC=$$LOC^DGPFUT63(.TMP)

 ;   filter for locally created history records only

 I SORT=1 Q LOC=1

 ;   filter for history records not created locally

 I SORT=2 Q LOC=0

Q 0

PAUSE ; pause screen display

 ;  if DGQ=1 exit printing

 I TRM,PAGE,$$E^DGPFUT7<1 S DGQ=1

STATUS(STAT) ;filter on active/inactive; DG*5.3*960

 ; "DGSTA": 1:inactive;2:active;3:both

 ;   STAT : 0:inactive;1:active

 N SORT S SORT=$G(DGSORT("DGSTA"))-1 S:SORT<0 SORT=2

 Q $S(SORT>1:1,SORT=1:STAT=1,1:STAT=0)

SUBTOT ;

 ;   Print subtotals for category at end of that category listing

 ;   Expects CAT and OCAT

 W !!,"Total Actions not Linked for Category "

 W $S(OCAT=1:"I",1:"II")_":  "_(+TOTAL(OCAT))

 D:+DGSORT("DGCAT")=3 PAUSE

 S ODFN=""

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFRAL1   11350     printed  Mar 13, 2025@21:53:09                                                                                                                                                                                                   Page 2

DGPFRAL1  ;ALB/RBS - PRF ACTION NOT LINKED REPORT CONT. ; 10/12/05 2:48pm

 +1       ;;5.3;Registration;**554,650,892,960**;Aug 13, 1993;Build 22

 +2       ;     Last Edited: SHRPE/SGM - July 9, 2018 15:55

 +3       ;

 +4       ; ICR# TYPE DESCRIPTION

 +5       ;----- ---- ---------------------

 +6       ;2171  Sup  $$STA^XUAF4

 +7       ;10024 Sup  WAIT^DICD

 +8       ;10063 Sup  $$S^%ZTLOAD

 +9       ;10086 Sup  HOME^%ZIS

 +10      ;10089 Sup  ^%ZISC

 +11      ;10103 Sup  ^XLFDT: $$FMTE, $$NOW

 +12      ;10112 Sup  $$SITE^VASITE

 +13      ;

 +14      ;This routine will be used to display or print all of the patient

 +15      ;assignment history records that are not linked to a progress note.

 +16      ;

 +17      ; INPUT:  DGSORT() - see comments at the top of routine DGPFRAL for

 +18      ;         explanation of DGSORT array

 +19      ;

 +20      ; Output:  A formatted report of patient Assignment History Actions

 +21      ;          that are not linked to a TIU Progress Note.

 +22      ;

 +23      ;- no direct entry

 +24       QUIT

 +25      ;

START     ; compile and print report

 +1        NEW DGLIST,DGQ,HD,TRM

 +2        DO INIT

 +3        DO LOOP

           IF 'DGQ

               DO PRINT(.DGSORT,DGLIST)

 +4       ;

EXIT      ;

 +1        KILL @DGLIST

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        IF 'DGQ

               IF TRM

                   SET X=$$E^DGPFUT7

                   WRITE @IOF

 +4        IF 'TRM

               IF $Y>0

                   WRITE @IOF

 +5        QUIT

 +6       ;

LOOP      ;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("DGPFRAL1",$J) - temp global containing report output

 +7       ;

 +8       ;beginning date

           NEW DGBEG

 +9       ;var used to check which category is being reported on

           NEW DGC

 +10      ;flag category

           NEW DGCAT

 +11      ;category 1 or 2

           NEW DGCATG

 +12      ;flag counter

           NEW DGCNT

 +13      ;pointer to patient being reported on

           NEW DGDFN

 +14      ;array of dfn's assigned to the flag

           NEW DGDFNLST

 +15      ;ending date

           NEW DGEND

 +16      ;array subscripted by assignment history date

           NEW DGHIENS

 +17      ;assignment ien

           NEW DGIEN

 +18      ;patient data array

           NEW DGPAT

 +19      ;assignment data array

           NEW DGPFA

 +20      ;loop flag

           NEW DGSUB

 +21      ;loop var

           NEW DGX

 +22      ;

 +23      ; setup variables equal to user input parameter subscripts

 +24      ;   "DGCAT", "DGBEG", "DGEND"

 +25       SET DGX=""

FOR

               SET DGX=$ORDER(DGSORT(DGX))

               if DGX=""

                   QUIT

               SET @DGX=DGSORT(DGX)

 +26       SET DGC=$SELECT(+DGCAT=3:0,1:+DGCAT)

 +27       if DGC

               SET DGC=$SELECT(DGC=1:26.15,1:26.11)

 +28       NEW DGI

           SET DGI=0

 +29      ;

 +30      ; loop assignment variable pointer flag x-ref file to run report

 +31       SET (DGDFN,DGIEN)=""

           SET (DGSUB,DGCNT)=0

 +32       FOR

               SET DGSUB=$ORDER(^DGPF(26.13,"AFLAG",DGSUB))

               if DGSUB=""

                   QUIT

               Begin DoDot:1

 +33      ;not correct file based on category

                   IF DGC

                       IF DGSUB'[DGC

                           QUIT

 +34               SET DGCATG=$SELECT(DGSUB[26.15:1,1:2)

 +35               KILL DGDFNLST

 +36               SET DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST)

 +37               if 'DGCNT

                       QUIT

 +38               SET DGDFN=""

 +39               FOR

                       SET DGDFN=$ORDER(DGDFNLST(DGDFN))

                       if DGDFN=""

                           QUIT

                       Begin DoDot:2

 +40                       SET DGI=1+DGI

                           IF '(DGI#200)

                               DO CHK

                               if DGQ

                                   QUIT

 +41                       SET DGIEN=$GET(DGDFNLST(DGDFN))

                           if DGIEN=""

                               QUIT

 +42      ; get assignment record

 +43                       KILL DGPFA

 +44                       if '$$GETASGN^DGPFAA(DGIEN,.DGPFA)

                               QUIT

 +45      ; check if calling site is owner site

 +46                       if '$$ISDIV^DGPFUT($PIECE(DGPFA("OWNER"),U))

                               QUIT

 +47      ;

 +48      ;filter patient when last action is ENTERED IN ERROR

 +49                       if $$ENTINERR(DGIEN)

                               QUIT

 +50      ;

 +51      ;filter for single flag - DG*5.3*960

 +52                       if '$$FLAGNM($PIECE(DGPFA("FLAG"),U))

                               QUIT

 +53      ;

 +54      ;filter on assignment status - DG*5.3*960

 +55                       if '$$STATUS(+DGPFA("STATUS"))

                               QUIT

 +56      ;

 +57      ;action ien array subscripted by assignment history date

 +58                       KILL DGHIENS

 +59                       if '$$GETALLDT^DGPFAAH(DGIEN,.DGHIENS)

                               QUIT

 +60      ; check if any Action's fall within the Begin and End dates

 +61                       IF $PIECE($ORDER(DGHIENS("")),".")'>DGEND&($PIECE($ORDER(DGHIENS(""),-1),".")'<DGBEG)

                               Begin DoDot:3

 +62      ;delete any action that is not within Begin and End dates

 +63                               SET DGX=0

FOR

                                       SET DGX=$ORDER(DGHIENS(DGX))

                                       if DGX=""

                                           QUIT

                                       Begin DoDot:4

 +64                                       IF $PIECE(DGX,".")<DGBEG!($PIECE(DGX,".")>DGEND)

                                               KILL DGHIENS(DGX)

                                       End DoDot:4

 +65                               if '$ORDER(DGHIENS(""))

                                       QUIT

 +66      ;

 +67      ; get patient demographics

 +68                               KILL DGPAT

 +69                               if '$$GETPAT^DGPFUT2(DGDFN,.DGPAT)

                                       QUIT

 +70      ;

 +71      ; call to build temp global

 +72                               DO BLDTMP(.DGPFA,.DGPAT,.DGHIENS,DGCATG,DGLIST)

                               End DoDot:3

                       End DoDot:2

                       if DGQ

                           QUIT

               End DoDot:1

               if DGQ

                   QUIT

 +73      ;

 +74       QUIT

 +75      ;

BLDTMP(DGPFA,DGPAT,DGHIENS,DGCATG,DGLIST) ; list global builder

 +1       ;  Input:

 +2       ;      DGPFA  - array of assignment record data

 +3       ;      DGPAT  - array of patient demographics

 +4       ;      DGHIENS - array of history action IEN's sorted by d/t

 +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      ;initial entry date

           NEW DGACTDT

 +12      ;flag name

           NEW DGFGNM

 +13      ;assignment ien

           NEW DGHIEN

 +14      ;report detail line

           NEW DGLINE

 +15      ;unique subscript counter

           NEW DGLNCNT

 +16      ;pointer to patient

           NEW DGPDFN

 +17      ;assignment history record data

           NEW DGPFAH

 +18      ;patient name

           NEW DGPNM

 +19      ;change of assignment flag

           NEW DGFLAG

 +20      ;

 +21      ; Check to see if this was a change of assignment

 +22       SET DGFLAG=0

 +23       NEW DGI

           SET DGI=0

 +24       DO FLGXFER

 +25      ;

 +26      ; loop all assignment history ien's

 +27       SET DGHIEN=""

           SET DGLNCNT=0

 +28       FOR

               SET DGHIEN=$ORDER(DGHIENS(DGHIEN))

               if DGHIEN=""

                   QUIT

               Begin DoDot:1

 +29               SET DGI=DGI+1

                   IF '(DGI#200)

                       DO CHK

                       if DGQ

                           QUIT

 +30      ;   get assignment history record

 +31               KILL DGPFAH

 +32               if '$$GETHIST^DGPFAAH(DGHIENS(DGHIEN),.DGPFAH)

                       QUIT

 +33      ;  progress note pointer

                   if +$GET(DGPFAH("TIULINK"))

                       QUIT

 +34      ; no ENTERED IN ERROR action

                   if +$GET(DGPFAH("ACTION"))=5

                       QUIT

 +35               SET DGACTDT=$$FMTE^XLFDT(+DGPFAH("ASSIGNDT")\1,"2Z")

 +36      ; if < assignment chg

                   IF DGFLAG

                       IF +DGPFAH("ASSIGNDT")'>DGFLAG

                           QUIT

 +37      ;              check local/not local DG*5.3*960

                   if '$$LOCAL()

                       QUIT

 +38               SET DGPNM=DGPAT("NAME")

 +39               if DGPNM']""

                       SET DGPNM="MISSING PATIENT NAME"

 +40               SET DGPDFN=$PIECE(DGPFA("DFN"),U)

 +41               SET DGFGNM=$PIECE(DGPFA("FLAG"),U,2)

 +42               if DGFGNM']""

                       SET DGFGNM="MISSING FLAG NAME"

 +43               SET DGLINE=$EXTRACT(DGPNM)_$EXTRACT(DGPAT("SSN"),6,10)_U_$EXTRACT(DGFGNM,1,17)

 +44               SET DGLINE=DGLINE_U_$PIECE(DGPFAH("ACTION"),U,2)_U_DGACTDT

 +45               SET DGLNCNT=DGLNCNT+1

 +46               SET @DGLIST@(DGCATG,DGFGNM,DGPNM,DGPDFN,DGLNCNT)=DGLINE

               End DoDot:1

               if DGQ

                   QUIT

 +47      ;

 +48       QUIT

 +49      ;

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       ;  flag category

           NEW CAT

 +8       ;  previous flag category

           NEW OCAT

 +9       ;  ien of patient

           NEW DFN

 +10      ;  previous DFN

           NEW ODFN

 +11      ;  flag name

           NEW FLAG

 +12      ;  patient name

           NEW NAM

 +13      ;  previoous flag name

           NEW OFLAG

 +14      ;  page counter

           NEW PAGE

 +15      ;  $query incrementing variable

           NEW REF

 +16      ;  string of detail line to display

           NEW STR

 +17       NEW I,X,Y,STOP,TOTAL

 +18      ;

 +19       SET (OCAT,ODFN,OFLAG)=""

 +20       SET REF=DGLIST

 +21       SET STOP=$TRANSLATE(REF,")",",")

 +22       SET (TOTAL,TOTAL(1),TOTAL(2))=0

 +23       SET PAGE=0

 +24      ;

 +25       IF $ORDER(@DGLIST@(""))=""

               Begin DoDot:1

 +26               DO HEAD

 +27               WRITE !!,"   >>> No Record Flag Assignments were found using the report criteria.",!

 +28               QUIT

               End DoDot:1

               QUIT

 +29      ;

 +30       FOR I=1:1

               SET REF=$QUERY(@REF)

               if REF=""

                   QUIT

               if REF'[STOP

                   QUIT

               Begin DoDot:1

 +31      ;  flag to indicate a new line is needed

                   NEW NL

                   SET NL=1

 +32               SET STR=@REF

 +33               SET CAT=$QSUBSCRIPT(REF,3)

                   SET FLAG=$QSUBSCRIPT(REF,4)

                   SET NAM=$QSUBSCRIPT(REF,5)

                   SET DFN=$QSUBSCRIPT(REF,6)

 +34      ; for each flag/pat combination, write flag and pat only once

 +35      ; however, repeat name/flag at beginning of new page

 +36      ; do header for each category change

 +37               IF CAT'=OCAT

                       IF +OCAT

                           DO SUBTOT

                           if DGQ

                               QUIT

 +38               IF CAT'=OCAT

                       DO HEAD

                       SET OCAT=CAT

 +39               IF $Y>(IOSL-4)

                       DO PAUSE

                       if DGQ

                           QUIT

                       DO HEAD

                       SET ODFN=""

 +40               IF DFN'=ODFN

                       Begin DoDot:2

 +41                       WRITE !,$EXTRACT(NAM,1,18),?20,$PIECE(STR,U),?32,$EXTRACT($PIECE(STR,U,2),1,17)

 +42                       SET ODFN=DFN

                           SET OFLAG=FLAG

                           SET NL=0

 +43                       QUIT

                       End DoDot:2

 +44      ; - write new flag name

 +45               IF OFLAG'=FLAG

                       SET OFLAG=FLAG

                       WRITE !?32,$EXTRACT($PIECE(STR,U,2),1,17),NL=0

 +46      ; - write action detail

 +47               if NL

                       WRITE !

                   WRITE ?51,$EXTRACT($PIECE(STR,U,3),1,16),?69,$PIECE(STR,U,4)

 +48               SET TOTAL(CAT)=TOTAL(CAT)+1

 +49               QUIT

               End DoDot:1

               if DGQ

                   QUIT

 +50      ;

 +51      ;   Last category subtotals did not print

 +52       SET OCAT=CAT

           DO SUBTOT

 +53      ;

 +54       DO CHK

 +55      ;   Print totals if both cat I & II selected

 +56       IF 'DGQ

               IF +DGSORT("DGCAT")=3

                   Begin DoDot:1

 +57                   IF 'TRM

                           IF (IOSL-$Y)<10

                               DO HEAD

 +58                   WRITE !!,"REPORT SUMMARY:",!,"---------------"

 +59                   WRITE !,"Total Actions not Linked for Category I:",?48,$JUSTIFY(TOTAL(1),7)

 +60                   WRITE !,"Total Actions not Linked for Category II:",?48,$JUSTIFY(TOTAL(2),7)

 +61                   WRITE !?48,"-------"

 +62                   SET X=TOTAL(1)+TOTAL(2)

 +63                   WRITE !,"Total Actions not Linked for Category I & II:",?48,$JUSTIFY(X,7)

 +64                   QUIT

                   End DoDot:1

 +65       WRITE !!,"<End of Report>"

 +66       QUIT

 +67      ;

 +68      ;-----------------------  PRIVATE SUBROUTINES  -----------------------

 +69      ;

CHK       ;

 +1       ;   Check is Taskman request to stop

 +2        IF 'DGQ

               IF $DATA(ZTQUEUED)

                   IF $$S^%ZTLOAD

                       SET (ZTSTOP,DGQ)=1

 +3        IF DGQ

               IF $DATA(ZTQUEUED)

                   WRITE !!,"REPORT STOPPED AT USER REQUEST",!

 +4        QUIT

 +5       ;

ENTINERR(DGIEN) ;

 +1       ;  Is last action ENTERED IN ERROR

 +2       ;  Input:

 +3       ;    DGIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file

 +4       ;

 +5       ;  Output:

 +6       ;   Function Value - Return 1 on success, 0 on failure

 +7       ;

 +8        NEW DGPFAH

 +9        IF $$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGIEN),.DGPFAH)

 +10       QUIT +$GET(DGPFAH("ACTION"))=5

 +11      ;

FLAGNM(FLG) ;

 +1       ;  Is flag = selected flag; DG*5.3*960

 +2       ;  "DGFLG": variable_pointer for flag, else ""

 +3        NEW SORT

           SET SORT=$PIECE($GET(DGSORT("DGFLG")),U,3)

 +4        QUIT $SELECT('SORT:1,1:SORT=FLG)

 +5       ;

FLGXFER   ;

 +1       ;   If flag transferred and prior to assignment change date

 +2       ;   then do not rpt missing TIU link

 +3        NEW X,DGHIEN,DGHACT

 +4        if $PIECE($GET(DGPFA("ORIGSITE")),U)=$PIECE($GET(DGPFA("OWNER")),U)

               QUIT

 +5        SET X="Change of flag assignment ownership."

 +6        SET DGHIEN=""

 +7        FOR

               SET DGHIEN=$ORDER(DGHIENS(DGHIEN))

               if DGHIEN=""

                   QUIT

               Begin DoDot:1

 +8                SET DGHACT=DGHIENS(DGHIEN)

 +9                IF $GET(^DGPF(26.14,DGHACT,1,1,0))[X

                       SET DGFLAG=$PIECE(DGHIEN,U)

               End DoDot:1

 +10       QUIT

 +11      ;

HEAD      ;

 +1       ;   Print/Display page header

 +2        NEW X

           DO CHK

           if DGQ

               QUIT

 +3        IF TRM!('TRM&PAGE)

               WRITE @IOF

 +4        SET PAGE=PAGE+1

 +5        SET X=$SELECT('$DATA(CAT):"",+CAT=1:"I (National)",1:"II (Local)")

 +6        FOR I=1:1:3

               WRITE !,HD(I)

               if I=2

                   WRITE $JUSTIFY(PAGE,5)

 +7        IF PAGE<2

               FOR I=1:1:4

                   WRITE !,HD(1,I)

 +8        IF $DATA(CAT)

               IF CAT'=OCAT

                   FOR I=1:1:4

                       WRITE !,HD(2,I)

                       if I=1

                           WRITE X

 +9        QUIT

 +10      ;

INIT      ;  initial certain local variables

 +1        NEW X,BEG,END,FLG,PRT,SP

 +2        SET $PIECE(SP," ",80)=""

 +3        SET TRM=($EXTRACT(IOST)="C")

           IF TRM

               DO WAIT^DICD

 +4       ;temp global for report

           SET DGLIST=$NAME(^TMP("DGPFRAL1",$JOB))

 +5        KILL @DGLIST

 +6        SET DGQ=0

 +7       ;

 +8       ;   header display for all pages

 +9        SET HD(1)=$EXTRACT(SP,1,24)_"Patient Record Flags"

 +10       SET X="Assignment Action Not Linked To A Progress Note Report"

 +11       SET $EXTRACT(X,68)="Page: "

 +12       SET HD(2)=X

 +13       SET $PIECE(HD(3),"-",80)=""

 +14      ;

 +15       SET BEG=$$FMTE^XLFDT(DGSORT("DGBEG"),"5Z")

 +16       SET END=$$FMTE^XLFDT(DGSORT("DGEND"),"5Z")

 +17       SET PRT=$$FMTE^XLFDT($$NOW^XLFDT,"MP")

 +18       SET FLG=$PIECE(DGSORT("DGFLG"),U,2)

           if FLG=""

               SET FLG="All flags"

 +19      ;

 +20      ;   display in header for first page only

 +21       SET HD(1,1)="REPORT TYPE: "_$PIECE(DGSORT("DGCAT"),U,2)

 +22       SET $EXTRACT(HD(1,1),47)="STATUS: "_$PIECE(DGSORT("DGSTA"),U,2)

 +23       SET HD(1,2)="       FLAG: "_FLG

 +24       SET $EXTRACT(HD(1,2),44)="ACTION BY: "_$PIECE(DGSORT("DGFAC"),U,2)

 +25       SET HD(1,3)=" DATE RANGE: "_BEG_" To "_END

 +26       SET $EXTRACT(HD(1,3),46)="PRINTED: "_PRT

 +27       SET HD(1,4)=HD(3)

 +28      ;

 +29      ;   sub-header display / column header display

 +30       SET HD(2,1)="   CATEGORY: "

 +31       SET HD(2,2)=""

 +32       SET HD(2,3)="PATIENT             SSN         FLAG NAME          ACTION            ACTION DATE"

 +33       SET HD(2,4)="------------------  ----------  -----------------  ----------------  -----------"

 +34       QUIT

 +35      ;

LOCAL()   ;

 +1       ;   Filter is history created locally or not; DG*5.3*960

 +2       ;   expects .DGPFAH; "DGFAC": 1:local;2:other;3:both

 +3        NEW X,LOC,SORT,TMP

 +4        SET SORT=+$GET(DGSORT("DGFAC"))

           IF SORT=3

               QUIT 1

 +5        FOR X="APPRVBY","ENTERBY","ORIGFAC"

               SET TMP(X)=$GET(DGPFAH(X))

 +6        SET LOC=$$LOC^DGPFUT63(.TMP)

 +7       ;   filter for locally created history records only

 +8        IF SORT=1

               QUIT LOC=1

 +9       ;   filter for history records not created locally

 +10       IF SORT=2

               QUIT LOC=0

 +11       QUIT 0

 +12      ;

PAUSE     ; pause screen display

 +1       ;  if DGQ=1 exit printing

 +2        IF TRM

               IF PAGE

                   IF $$E^DGPFUT7<1

                       SET DGQ=1

 +3        QUIT

 +4       ;

STATUS(STAT) ;filter on active/inactive; DG*5.3*960

 +1       ; "DGSTA": 1:inactive;2:active;3:both

 +2       ;   STAT : 0:inactive;1:active

 +3        NEW SORT

           SET SORT=$GET(DGSORT("DGSTA"))-1

           if SORT<0

               SET SORT=2

 +4        QUIT $SELECT(SORT>1:1,SORT=1:STAT=1,1:STAT=0)

 +5       ;

SUBTOT    ;

 +1       ;   Print subtotals for category at end of that category listing

 +2       ;   Expects CAT and OCAT

 +3        WRITE !!,"Total Actions not Linked for Category "

 +4        WRITE $SELECT(OCAT=1:"I",1:"II")_":  "_(+TOTAL(OCAT))

 +5        if +DGSORT("DGCAT")=3

               DO PAUSE

 +6        SET ODFN=""

 +7        QUIT

DGPFRAL1.m