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
Q
;
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)
;
Q
;
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
;
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 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>"
Q
;
;----------------------- 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",!
Q
;
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)
Q
;
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
Q
;
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)="------------------ ---------- ----------------- ---------------- -----------"
Q
;
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
Q
;
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=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFRAL1 11350 printed Sep 23, 2025@20:24:28 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
