ORAERPT1 ; SPFO/AJB - Alert Enhancements Reports ;Feb 21, 2020@13:04:05
;;3.0;ORDER ENTRY/RESULTS REPORTING;**518**;Dec 17, 1997;Build 11
Q ;
FILTERED ;
N DIV,LOC,NTF,SAVE,SRV,TTL,TXT,TYP,USR
;S TIME("Start","F")=$$NOW^XLFDT
I '+$G(SETUP) D SETUP^ORAERPT ; create dynamic filter criteria in the protocol file
;S TIME("Stop","F")=$$NOW^XLFDT,TIME("Total","F")=$FN($$FMDIFF^XLFDT(TIME("Start","F"),TIME("Stop","F"),2)/60,"-") ; timing information
;W !!,TIME("Total","F")
W !!,"Enter the criteria for filtering. Enter '?' for more information."
S FLTR=$$ASK^ORAERPT(.FLTR,"A","RECIPIENT","ORAE MENU FILTER "_$J,"Filter by: ") I FLTR'>0 Q
S Y=FLTR F X=1:1:Y S:X=1 FLTR=$P(FLTR(X),U,3) S:X>1 $P(FLTR,U,X)=$P(FLTR(X),U,3) K FLTR(X)
S X("NOTIFICATION")="NTF",X("DIVISION")="DIV",X("RECIPIENT")="USR",X("LOCATION")="LOC",X("SERVICE")="SRV",X("TITLE")="TTL"
S FLTR=$$REPLACE^XLFSTR(FLTR,.X) D
. ; remove duplicate filter entries
. N CNT,TMP S CNT=0,TMP=FLTR K FLTR S FLTR=""
. F X=1:1:$L(TMP,U) I FLTR'[$P(TMP,U,X) S CNT=CNT+1,$P(FLTR,U,CNT)=$P(TMP,U,X)
F X=1:1:$L(FLTR,U) D Q:@TYP'>0
. S TYP=$P(FLTR,U,X)
. N DEFAULT S DEFAULT=$P(TOP10(TYP,1),U)
. S DEFAULT=$S(TYP="USR":$TR(DEFAULT,","," "),DEFAULT["z<":$E(DEFAULT,2,$L(DEFAULT)),DEFAULT["-":$TR(DEFAULT,"-"," "),1:DEFAULT)
. S @TYP=$$ASK^ORAERPT(.@TYP,"A",DEFAULT,"ORAE MENU "_TYP_" "_$J,$S(TYP="DIV":"DIVISION",TYP="LOC":"LOCATION",TYP="NTF":"NOTIFICATION",TYP="SRV":"SERVICE",TYP="TTL":"TITLE",TYP="USR":"RECIPIENT")_": ","D HELP1^ORAEHLP")
Q:@TYP'>0
;
F X=1:1:$L(FLTR,U) S TYP=$P(FLTR,U,X),FLTR(X)=TYP ; get types to filter in order of entry
S X=0 F S X=$O(FLTR(X)) Q:'+X D
. S TYP=FLTR(X) I $P(@TYP@(1),U,4)="ALL" K @TYP Q ; remove filter for ALL entries by a type
. N CNT S (CNT,Y)=0 F S Y=$O(@TYP@(Y)) Q:'+Y S @TYP@(Y)=$P(^ORD(101,$P(@TYP@(Y),U,2),0),U,2) ; set to data from File #101
;
; evaluate filter to ensure either USER or NOTIFICATION centric display
I FLTR'["USR",FLTR'["NTF" S FLTR(1)="USR" ; neither, user centric
I FLTR'["USR",FLTR["NTF" S FLTR(1)="NTF" ; ntf centric
I FLTR["USR",FLTR'["NTF" S FLTR(1)="USR" ; usr centric
I FLTR["USR",FLTR["NTF" D ; if both...
. I $L(FLTR,U)=6 S FLTR(1)="USR" Q ; if ALL, set user centric display
. F X=1:1:$L(FLTR,U) I $P(FLTR,U,X)="NTF"!($P(FLTR,U,X)="USR") S FLTR(1)=$P(FLTR,U,X) Q ; set in order of entry
;
; filter entries to display
N CNT,CONT S CONT=0 S USR="" F S USR=$O(@TMP@("ALL",USR)) Q:USR="" D
. I +$D(USR(1)) D Q:'+CONT
. . S (CNT,CONT)=0 F S CNT=$O(USR(CNT)) Q:'+CNT I $TR(USR,"z<","<")=USR(CNT) S CONT=1
. S TTL="" F S TTL=$O(@TMP@("ALL",USR,TTL)) Q:TTL="" D
. . I +$D(TTL(1)) D Q:'+CONT
. . . S (CNT,CONT)=0 F S CNT=$O(TTL(CNT)) Q:'+CNT I $TR(TTL,"z<","<")=TTL(CNT) S CONT=1
. . S SRV="" F S SRV=$O(@TMP@("ALL",USR,TTL,SRV)) Q:SRV="" D
. . . I +$D(SRV(1)) D Q:'+CONT
. . . . S (CNT,CONT)=0 F S CNT=$O(SRV(CNT)) Q:'+CNT I $TR(SRV,"z<","<")=SRV(CNT) S CONT=1
. . . S NTF="" F S NTF=$O(@TMP@("ALL",USR,TTL,SRV,NTF)) Q:NTF="" D
. . . . I +$D(NTF(1)) D Q:'+CONT
. . . . . S (CNT,CONT)=0 F S CNT=$O(NTF(CNT)) Q:'+CNT I $TR(NTF,"z<","<")=NTF(CNT) S CONT=1
. . . . S DIV="" F S DIV=$O(@TMP@("ALL",USR,TTL,SRV,NTF,DIV)) Q:DIV="" D
. . . . . I +$D(DIV(1)) D Q:'+CONT
. . . . . . S (CNT,CONT)=0 F S CNT=$O(DIV(CNT)) Q:'+CNT I $TR(DIV,"z<","<")=DIV(CNT) S CONT=1
. . . . . S LOC="" F S LOC=$O(@TMP@("ALL",USR,TTL,SRV,NTF,DIV,LOC)) Q:LOC="" D
. . . . . . I +$D(LOC(1)) D Q:'+CONT
. . . . . . . S (CNT,CONT)=0 F S CNT=$O(LOC(CNT)) Q:'+CNT I $TR(LOC,"z<","<")=LOC(CNT) S CONT=1
. . . . . . S @TMP@("FILTER",FLTR(1),$S(FLTR(1)="NTF":NTF,1:USR),$S(FLTR(1)="NTF":USR,1:NTF),TTL,SRV,DIV,LOC)=@TMP@("ALL",USR,TTL,SRV,NTF,DIV,LOC)
;
N HDR S CNT=0,TYP="",TYP=$O(@TMP@("FILTER",TYP)) Q:TYP=""
D ; set up the data header information
. S HDR(1)=$S(TYP="NTF":"NOTIFICATION",1:"RECIPIENT")
. S HDR(2)=$S(TYP="NTF":" RECIPIENT",1:" NOTIFICATION")
. S:FLTR["TTL" HDR($S(TYP="USR":1,1:2))=HDR($S(TYP="USR":1,1:2))_" [TITLE"_$S(FLTR["SRV":"",1:"]")
. S:FLTR["SRV" HDR($S(TYP="USR":1,1:2))=HDR($S(TYP="USR":1,1:2))_$S(FLTR["TTL":"/SERVICE]",1:" [SERVICE]")
. I FLTR'["DIV",FLTR["LOC" D Q
. . I FLTR["SRV"!(FLTR["TTL") S HDR($S(TYP="USR":2,1:3))=$$SETSTR^VALM1("LOCATION",$G(HDR($S(TYP="USR":2,1:3))),40,8),HDR($S(TYP="USR":2,1:3))=$$SETSTR^VALM1("TOTAL",HDR($S(TYP="USR":2,1:3)),76,5)
. . I FLTR'["SRV",FLTR'["TTL" S HDR(2)=$$SETSTR^VALM1("LOCATION",HDR(2),40,8),HDR(2)=$$SETSTR^VALM1("TOTAL",HDR(2),76,5)
. . S $P(HDR(3),"=",80)="="
. I FLTR["DIV" S HDR(3)=" DIVISION" S:FLTR["LOC" HDR(3)=$$SETSTR^VALM1("LOCATION",$S(FLTR["DIV":HDR(3),1:""),40,8)
. I FLTR["DIV" S HDR(3)=$$SETSTR^VALM1("TOTAL",$G(HDR(3)),76,5),$P(HDR(4),"=",80)="=" Q
. S HDR(2)=$$SETSTR^VALM1("TOTAL",HDR(2),76,5),$P(HDR(3),"=",80)="="
;
S NTF="" F S NTF=$O(@TMP@("FILTER",TYP,NTF)) Q:NTF="" D
. N ENT,SUM,VAL S SUM=0
. S CNT=CNT+1,TXT(CNT)=NTF,ENT=CNT ; Notification or User, keep track on initial ENTRY line CNT
. S USR="" F S USR=$O(@TMP@("FILTER",TYP,NTF,USR)) Q:USR="" D
. . S CNT=CNT+1,TXT(CNT)=$$SETSTR^VALM1(USR,"",3,$L(USR)) ; Notification or User
. . S TTL="" F S TTL=$O(@TMP@("FILTER",TYP,NTF,USR,TTL)) Q:TTL="" D
. . . S SRV="" F S SRV=$O(@TMP@("FILTER",TYP,NTF,USR,TTL,SRV)) Q:SRV="" D
. . . . I TYP="USR" D ; add TITLE/SERVICE to main entry (USER) using ENT
. . . . . N TMP S TMP=" ["_$TR(TTL,"z<","<")_$S(FLTR["SRV":"",1:"]")
. . . . . I TXT(ENT)'[$TR(TTL,"z<","<") S:FLTR["TTL" TXT(ENT)=$$SETSTR^VALM1(TMP,TXT(ENT),($L(TXT(ENT))+1),$L(TMP))
. . . . . S TMP=$S(FLTR["TTL":"/",1:" [")_$TR(SRV,"z<","<")_"]"
. . . . . I TXT(ENT)'[$TR(SRV,"z<","<") S:FLTR["SRV" TXT(ENT)=$$SETSTR^VALM1(TMP,TXT(ENT),($L(TXT(ENT))+1),$L(TMP))
. . . . I TYP="NTF" D ; add TITLE/SERVICE to main entry (NTF)
. . . . . N TMP S TMP=" ["_$TR(TTL,"z<","<")_$S(FLTR["SRV":"",1:"]")
. . . . . I TXT(CNT)'[$TR(TTL,"z<","<") S:FLTR["TTL" TXT(CNT)=$$SETSTR^VALM1(TMP,TXT(CNT),($L(TXT(CNT))+1),$L(TMP))
. . . . . S TMP=$S(FLTR["TTL":"/",1:" [")_$TR(SRV,"z<","<")_"]"
. . . . . I TXT(CNT)'[$TR(SRV,"z<","<") S:FLTR["SRV" TXT(CNT)=$$SETSTR^VALM1(TMP,TXT(CNT),($L(TXT(CNT))+1),$L(TMP))
. . . . S DIV("TOTAL")=0,DIV="" F S DIV=$O(@TMP@("FILTER",TYP,NTF,USR,TTL,SRV,DIV)) Q:DIV="" D
. . . . . I FLTR["DIV" S CNT=CNT+1,TXT(CNT)=$$SETSTR^VALM1($TR(DIV,"z<","<"),"",5,$L($TR(DIV,"z<","<")))
. . . . . S LOC="",VAL=0 F S LOC=$O(@TMP@("FILTER",TYP,NTF,USR,TTL,SRV,DIV,LOC)) Q:LOC="" D
. . . . . . I FLTR["LOC" D ; display location
. . . . . . . I FLTR'["DIV",TYP="NTF" I FLTR["SRV"!(FLTR["TTL") S VAL=1
. . . . . . . S:VAL>0 CNT=CNT+1 S TXT(CNT)=$$SETSTR^VALM1($TR(LOC,"z<","<"),$S(VAL>0:"",1:TXT(CNT)),40,$L($TR(LOC,"z<","<")))
. . . . . . . S TXT(CNT)=$$SETSTR^VALM1(@TMP@("FILTER",TYP,NTF,USR,TTL,SRV,DIV,LOC),TXT(CNT),(IOM-$L(@TMP@("FILTER",TYP,NTF,USR,TTL,SRV,DIV,LOC))+1),$L(@TMP@("FILTER",TYP,NTF,USR,TTL,SRV,DIV,LOC)))
. . . . . . S VAL=VAL+@TMP@("FILTER",TYP,NTF,USR,TTL,SRV,DIV,LOC) ; total sum by LOC
. . . . . . S SUM=SUM+@TMP@("FILTER",TYP,NTF,USR,TTL,SRV,DIV,LOC) ; total sum by NTF (Recipient or Notification)
. . . . . S DIV("TOTAL")=DIV("TOTAL")+VAL ; add location sum to DIV
. . . . . I FLTR["DIV",FLTR'["LOC" S TXT(CNT)=$$SETSTR^VALM1(VAL,TXT(CNT),(IOM-$L(VAL)+1),$L(VAL))
. . I FLTR'["DIV",FLTR'["LOC" S TXT(CNT)=$$SETSTR^VALM1(DIV("TOTAL"),TXT(CNT),(IOM-$L(DIV("TOTAL"))+1),$L(DIV("TOTAL"))) ; display sum by DIVISION
. ;S CNT=CNT+1,TXT(CNT)=$$SETSTR^VALM1(SUM,"",(IOM-$L(SUM)+1),$L(SUM)) ; display total
. I $O(@TMP@("FILTER",TYP,NTF))'="" S CNT=CNT+1,TXT(CNT)="" ; add a blank line between entries
;
S (SAVE("HDR"),SAVE("TXT"))="" W ! D EN^XUTMDEVQ("DISPLAY^ORAERPT(.TXT)","Filter Report",.SAVE)
K @TMP@("FILTER"),FLTR
Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORAERPT1 7848 printed Apr 09, 2024@21:30:22 Page 2
ORAERPT1 ; SPFO/AJB - Alert Enhancements Reports ;Feb 21, 2020@13:04:05
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**518**;Dec 17, 1997;Build 11
+2 ;
QUIT
FILTERED ;
+1 NEW DIV,LOC,NTF,SAVE,SRV,TTL,TXT,TYP,USR
+2 ;S TIME("Start","F")=$$NOW^XLFDT
+3 ; create dynamic filter criteria in the protocol file
IF '+$GET(SETUP)
DO SETUP^ORAERPT
+4 ;S TIME("Stop","F")=$$NOW^XLFDT,TIME("Total","F")=$FN($$FMDIFF^XLFDT(TIME("Start","F"),TIME("Stop","F"),2)/60,"-") ; timing information
+5 ;W !!,TIME("Total","F")
+6 WRITE !!,"Enter the criteria for filtering. Enter '?' for more information."
+7 SET FLTR=$$ASK^ORAERPT(.FLTR,"A","RECIPIENT","ORAE MENU FILTER "_$JOB,"Filter by: ")
IF FLTR'>0
QUIT
+8 SET Y=FLTR
FOR X=1:1:Y
if X=1
SET FLTR=$PIECE(FLTR(X),U,3)
if X>1
SET $PIECE(FLTR,U,X)=$PIECE(FLTR(X),U,3)
KILL FLTR(X)
+9 SET X("NOTIFICATION")="NTF"
SET X("DIVISION")="DIV"
SET X("RECIPIENT")="USR"
SET X("LOCATION")="LOC"
SET X("SERVICE")="SRV"
SET X("TITLE")="TTL"
+10 SET FLTR=$$REPLACE^XLFSTR(FLTR,.X)
Begin DoDot:1
+11 ; remove duplicate filter entries
+12 NEW CNT,TMP
SET CNT=0
SET TMP=FLTR
KILL FLTR
SET FLTR=""
+13 FOR X=1:1:$LENGTH(TMP,U)
IF FLTR'[$PIECE(TMP,U,X)
SET CNT=CNT+1
SET $PIECE(FLTR,U,CNT)=$PIECE(TMP,U,X)
End DoDot:1
+14 FOR X=1:1:$LENGTH(FLTR,U)
Begin DoDot:1
+15 SET TYP=$PIECE(FLTR,U,X)
+16 NEW DEFAULT
SET DEFAULT=$PIECE(TOP10(TYP,1),U)
+17 SET DEFAULT=$SELECT(TYP="USR":$TRANSLATE(DEFAULT,","," "),DEFAULT["z<":$EXTRACT(DEFAULT,2,$LENGTH(DEFAULT)),DEFAULT["-":$TRANSLATE(DEFAULT,"-"," "),1:DEFAULT)
+18 SET @TYP=$$ASK^ORAERPT(.@TYP,"A",DEFAULT,"ORAE MENU "_TYP_" "_$JOB,$SELECT(TYP="DIV":"DIVISION",TYP="LOC":"LOCATION",TYP="NTF":"NOTIFICATION",TYP="SRV":"SERVICE",TYP="TTL":"TITLE",TYP="USR":"RECIPIENT")_": ","D HELP1^ORAEHLP")
End DoDot:1
if @TYP'>0
QUIT
+19 if @TYP'>0
QUIT
+20 ;
+21 ; get types to filter in order of entry
FOR X=1:1:$LENGTH(FLTR,U)
SET TYP=$PIECE(FLTR,U,X)
SET FLTR(X)=TYP
+22 SET X=0
FOR
SET X=$ORDER(FLTR(X))
if '+X
QUIT
Begin DoDot:1
+23 ; remove filter for ALL entries by a type
SET TYP=FLTR(X)
IF $PIECE(@TYP@(1),U,4)="ALL"
KILL @TYP
QUIT
+24 ; set to data from File #101
NEW CNT
SET (CNT,Y)=0
FOR
SET Y=$ORDER(@TYP@(Y))
if '+Y
QUIT
SET @TYP@(Y)=$PIECE(^ORD(101,$PIECE(@TYP@(Y),U,2),0),U,2)
End DoDot:1
+25 ;
+26 ; evaluate filter to ensure either USER or NOTIFICATION centric display
+27 ; neither, user centric
IF FLTR'["USR"
IF FLTR'["NTF"
SET FLTR(1)="USR"
+28 ; ntf centric
IF FLTR'["USR"
IF FLTR["NTF"
SET FLTR(1)="NTF"
+29 ; usr centric
IF FLTR["USR"
IF FLTR'["NTF"
SET FLTR(1)="USR"
+30 ; if both...
IF FLTR["USR"
IF FLTR["NTF"
Begin DoDot:1
+31 ; if ALL, set user centric display
IF $LENGTH(FLTR,U)=6
SET FLTR(1)="USR"
QUIT
+32 ; set in order of entry
FOR X=1:1:$LENGTH(FLTR,U)
IF $PIECE(FLTR,U,X)="NTF"!($PIECE(FLTR,U,X)="USR")
SET FLTR(1)=$PIECE(FLTR,U,X)
QUIT
End DoDot:1
+33 ;
+34 ; filter entries to display
+35 NEW CNT,CONT
SET CONT=0
SET USR=""
FOR
SET USR=$ORDER(@TMP@("ALL",USR))
if USR=""
QUIT
Begin DoDot:1
+36 IF +$DATA(USR(1))
Begin DoDot:2
+37 SET (CNT,CONT)=0
FOR
SET CNT=$ORDER(USR(CNT))
if '+CNT
QUIT
IF $TRANSLATE(USR,"z<","<")=USR(CNT)
SET CONT=1
End DoDot:2
if '+CONT
QUIT
+38 SET TTL=""
FOR
SET TTL=$ORDER(@TMP@("ALL",USR,TTL))
if TTL=""
QUIT
Begin DoDot:2
+39 IF +$DATA(TTL(1))
Begin DoDot:3
+40 SET (CNT,CONT)=0
FOR
SET CNT=$ORDER(TTL(CNT))
if '+CNT
QUIT
IF $TRANSLATE(TTL,"z<","<")=TTL(CNT)
SET CONT=1
End DoDot:3
if '+CONT
QUIT
+41 SET SRV=""
FOR
SET SRV=$ORDER(@TMP@("ALL",USR,TTL,SRV))
if SRV=""
QUIT
Begin DoDot:3
+42 IF +$DATA(SRV(1))
Begin DoDot:4
+43 SET (CNT,CONT)=0
FOR
SET CNT=$ORDER(SRV(CNT))
if '+CNT
QUIT
IF $TRANSLATE(SRV,"z<","<")=SRV(CNT)
SET CONT=1
End DoDot:4
if '+CONT
QUIT
+44 SET NTF=""
FOR
SET NTF=$ORDER(@TMP@("ALL",USR,TTL,SRV,NTF))
if NTF=""
QUIT
Begin DoDot:4
+45 IF +$DATA(NTF(1))
Begin DoDot:5
+46 SET (CNT,CONT)=0
FOR
SET CNT=$ORDER(NTF(CNT))
if '+CNT
QUIT
IF $TRANSLATE(NTF,"z<","<")=NTF(CNT)
SET CONT=1
End DoDot:5
if '+CONT
QUIT
+47 SET DIV=""
FOR
SET DIV=$ORDER(@TMP@("ALL",USR,TTL,SRV,NTF,DIV))
if DIV=""
QUIT
Begin DoDot:5
+48 IF +$DATA(DIV(1))
Begin DoDot:6
+49 SET (CNT,CONT)=0
FOR
SET CNT=$ORDER(DIV(CNT))
if '+CNT
QUIT
IF $TRANSLATE(DIV,"z<","<")=DIV(CNT)
SET CONT=1
End DoDot:6
if '+CONT
QUIT
+50 SET LOC=""
FOR
SET LOC=$ORDER(@TMP@("ALL",USR,TTL,SRV,NTF,DIV,LOC))
if LOC=""
QUIT
Begin DoDot:6
+51 IF +$DATA(LOC(1))
Begin DoDot:7
+52 SET (CNT,CONT)=0
FOR
SET CNT=$ORDER(LOC(CNT))
if '+CNT
QUIT
IF $TRANSLATE(LOC,"z<","<")=LOC(CNT)
SET CONT=1
End DoDot:7
if '+CONT
QUIT
+53 SET @TMP@("FILTER",FLTR(1),$SELECT(FLTR(1)="NTF":NTF,1:USR),$SELECT(FLTR(1)="NTF":USR,1:NTF),TTL,SRV,DIV,LOC)=@TMP@("ALL",USR,TTL,SRV,NTF,DIV,LOC)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+54 ;
+55 NEW HDR
SET CNT=0
SET TYP=""
SET TYP=$ORDER(@TMP@("FILTER",TYP))
if TYP=""
QUIT
+56 ; set up the data header information
Begin DoDot:1
+57 SET HDR(1)=$SELECT(TYP="NTF":"NOTIFICATION",1:"RECIPIENT")
+58 SET HDR(2)=$SELECT(TYP="NTF":" RECIPIENT",1:" NOTIFICATION")
+59 if FLTR["TTL"
SET HDR($SELECT(TYP="USR":1,1:2))=HDR($SELECT(TYP="USR":1,1:2))_" [TITLE"_$SELECT(FLTR["SRV":"",1:"]")
+60 if FLTR["SRV"
SET HDR($SELECT(TYP="USR":1,1:2))=HDR($SELECT(TYP="USR":1,1:2))_$SELECT(FLTR["TTL":"/SERVICE]",1:" [SERVICE]")
+61 IF FLTR'["DIV"
IF FLTR["LOC"
Begin DoDot:2
+62 IF FLTR["SRV"!(FLTR["TTL")
SET HDR($SELECT(TYP="USR":2,1:3))=$$SETSTR^VALM1("LOCATION",$GET(HDR($SELECT(TYP="USR":2,1:3))),40,8)
SET HDR($SELECT(TYP="USR":2,1:3))=$$SETSTR^VALM1("TOTAL",HDR($SELECT(TYP="USR":2,1:3)),76,5)
+63 IF FLTR'["SRV"
IF FLTR'["TTL"
SET HDR(2)=$$SETSTR^VALM1("LOCATION",HDR(2),40,8)
SET HDR(2)=$$SETSTR^VALM1("TOTAL",HDR(2),76,5)
+64 SET $PIECE(HDR(3),"=",80)="="
End DoDot:2
QUIT
+65 IF FLTR["DIV"
SET HDR(3)=" DIVISION"
if FLTR["LOC"
SET HDR(3)=$$SETSTR^VALM1("LOCATION",$SELECT(FLTR["DIV":HDR(3),1:""),40,8)
+66 IF FLTR["DIV"
SET HDR(3)=$$SETSTR^VALM1("TOTAL",$GET(HDR(3)),76,5)
SET $PIECE(HDR(4),"=",80)="="
QUIT
+67 SET HDR(2)=$$SETSTR^VALM1("TOTAL",HDR(2),76,5)
SET $PIECE(HDR(3),"=",80)="="
End DoDot:1
+68 ;
+69 SET NTF=""
FOR
SET NTF=$ORDER(@TMP@("FILTER",TYP,NTF))
if NTF=""
QUIT
Begin DoDot:1
+70 NEW ENT,SUM,VAL
SET SUM=0
+71 ; Notification or User, keep track on initial ENTRY line CNT
SET CNT=CNT+1
SET TXT(CNT)=NTF
SET ENT=CNT
+72 SET USR=""
FOR
SET USR=$ORDER(@TMP@("FILTER",TYP,NTF,USR))
if USR=""
QUIT
Begin DoDot:2
+73 ; Notification or User
SET CNT=CNT+1
SET TXT(CNT)=$$SETSTR^VALM1(USR,"",3,$LENGTH(USR))
+74 SET TTL=""
FOR
SET TTL=$ORDER(@TMP@("FILTER",TYP,NTF,USR,TTL))
if TTL=""
QUIT
Begin DoDot:3
+75 SET SRV=""
FOR
SET SRV=$ORDER(@TMP@("FILTER",TYP,NTF,USR,TTL,SRV))
if SRV=""
QUIT
Begin DoDot:4
+76 ; add TITLE/SERVICE to main entry (USER) using ENT
IF TYP="USR"
Begin DoDot:5
+77 NEW TMP
SET TMP=" ["_$TRANSLATE(TTL,"z<","<")_$SELECT(FLTR["SRV":"",1:"]")
+78 IF TXT(ENT)'[$TRANSLATE(TTL,"z<","<")
if FLTR["TTL"
SET TXT(ENT)=$$SETSTR^VALM1(TMP,TXT(ENT),($LENGTH(TXT(ENT))+1),$LENGTH(TMP))
+79 SET TMP=$SELECT(FLTR["TTL":"/",1:" [")_$TRANSLATE(SRV,"z<","<")_"]"
+80 IF TXT(ENT)'[$TRANSLATE(SRV,"z<","<")
if FLTR["SRV"
SET TXT(ENT)=$$SETSTR^VALM1(TMP,TXT(ENT),($LENGTH(TXT(ENT))+1),$LENGTH(TMP))
End DoDot:5
+81 ; add TITLE/SERVICE to main entry (NTF)
IF TYP="NTF"
Begin DoDot:5
+82 NEW TMP
SET TMP=" ["_$TRANSLATE(TTL,"z<","<")_$SELECT(FLTR["SRV":"",1:"]")
+83 IF TXT(CNT)'[$TRANSLATE(TTL,"z<","<")
if FLTR["TTL"
SET TXT(CNT)=$$SETSTR^VALM1(TMP,TXT(CNT),($LENGTH(TXT(CNT))+1),$LENGTH(TMP))
+84 SET TMP=$SELECT(FLTR["TTL":"/",1:" [")_$TRANSLATE(SRV,"z<","<")_"]"
+85 IF TXT(CNT)'[$TRANSLATE(SRV,"z<","<")
if FLTR["SRV"
SET TXT(CNT)=$$SETSTR^VALM1(TMP,TXT(CNT),($LENGTH(TXT(CNT))+1),$LENGTH(TMP))
End DoDot:5
+86 SET DIV("TOTAL")=0
SET DIV=""
FOR
SET DIV=$ORDER(@TMP@("FILTER",TYP,NTF,USR,TTL,SRV,DIV))
if DIV=""
QUIT
Begin DoDot:5
+87 IF FLTR["DIV"
SET CNT=CNT+1
SET TXT(CNT)=$$SETSTR^VALM1($TRANSLATE(DIV,"z<","<"),"",5,$LENGTH($TRANSLATE(DIV,"z<","<")))
+88 SET LOC=""
SET VAL=0
FOR
SET LOC=$ORDER(@TMP@("FILTER",TYP,NTF,USR,TTL,SRV,DIV,LOC))
if LOC=""
QUIT
Begin DoDot:6
+89 ; display location
IF FLTR["LOC"
Begin DoDot:7
+90 IF FLTR'["DIV"
IF TYP="NTF"
IF FLTR["SRV"!(FLTR["TTL")
SET VAL=1
+91 if VAL>0
SET CNT=CNT+1
SET TXT(CNT)=$$SETSTR^VALM1($TRANSLATE(LOC,"z<","<"),$SELECT(VAL>0:"",1:TXT(CNT)),40,$LENGTH($TRANSLATE(LOC,"z<","<")))
+92 SET TXT(CNT)=$$SETSTR^VALM1(@TMP@("FILTER",TYP,NTF,USR,TTL,SRV,DIV,LOC),TXT(CNT),(IOM-$LENGTH(@TMP@("FILTER",TYP,NTF,USR,TTL,SRV,DIV,LOC))+1),$LENGTH(@TMP@("FILTER",TYP,NTF,USR,TTL,SRV,DIV
,LOC)))
End DoDot:7
+93 ; total sum by LOC
SET VAL=VAL+@TMP@("FILTER",TYP,NTF,USR,TTL,SRV,DIV,LOC)
+94 ; total sum by NTF (Recipient or Notification)
SET SUM=SUM+@TMP@("FILTER",TYP,NTF,USR,TTL,SRV,DIV,LOC)
End DoDot:6
+95 ; add location sum to DIV
SET DIV("TOTAL")=DIV("TOTAL")+VAL
+96 IF FLTR["DIV"
IF FLTR'["LOC"
SET TXT(CNT)=$$SETSTR^VALM1(VAL,TXT(CNT),(IOM-$LENGTH(VAL)+1),$LENGTH(VAL))
End DoDot:5
End DoDot:4
End DoDot:3
+97 ; display sum by DIVISION
IF FLTR'["DIV"
IF FLTR'["LOC"
SET TXT(CNT)=$$SETSTR^VALM1(DIV("TOTAL"),TXT(CNT),(IOM-$LENGTH(DIV("TOTAL"))+1),$LENGTH(DIV("TOTAL")))
End DoDot:2
+98 ;S CNT=CNT+1,TXT(CNT)=$$SETSTR^VALM1(SUM,"",(IOM-$L(SUM)+1),$L(SUM)) ; display total
+99 ; add a blank line between entries
IF $ORDER(@TMP@("FILTER",TYP,NTF))'=""
SET CNT=CNT+1
SET TXT(CNT)=""
End DoDot:1
+100 ;
+101 SET (SAVE("HDR"),SAVE("TXT"))=""
WRITE !
DO EN^XUTMDEVQ("DISPLAY^ORAERPT(.TXT)","Filter Report",.SAVE)
+102 KILL @TMP@("FILTER"),FLTR
+103 QUIT
+104 QUIT
