BPSOS2 ;BHAM ISC/FCS/DRS - ECME manager's ScreenMan ;06/01/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; ECME Statistics Screen
; Called by option BPS STATISTICS
; Uses List Template BPS STATISTICS AND MANAGEMENT
; Original IHS logic had many management function, which are no
; longer used
;
; ALL writes of screen lines should be done as follows:
; IF $$VISIBLE(line) DO WRITE^VALM10(line)
; Then NODISPLY can be set so that $$VISIBLE always returns FALSE
Q
;
EN ;EP - Option BPS STATISTICS
N BASE,CURR,DISP,AVG,CHG
; BASE(*) = base values, from when zeroed things out
; CURR(*) = current values, from most recent read
; CHG(*) = changed value to print, if any
D FETCHES(0) ; fetch stats into CURR() array - possibly reset BASE array
M CHG=CURR
D DIFF
S ^TMP("BPSOS2",$J,"FREQ")=30
I $P($G(^BPSECX("S",1,0)),U,2)="" D
.N %,%H,%I,X D NOW^%DTC S $P(^BPSECX("S",1,0),U,2)=%
D EN^VALM("BPS STATISTICS AND MANAGEMENT")
Q
;
INIT ; Entry Code - Init variables and list array
N NODISPLY S NODISPLY=1
D CLEAN^VALM10
S VALMCNT=0 ; 0 lines so far
D LABELS^BPSOS2C
D HDR
D FETCHES(1) ; set up CURR
M CHG=CURR
D DIFF ; compute DIFF = differences and changed ones go into CHG
D VALUES^BPSOS2B ; displays whatever's in CHG() and kills it off
Q
;
; Define Current (CURR) array and reset BASE
;
; Input variable -> B = 0 Reset (kill) BASE values and retrieve
; values
; 1 Just retrieve current values
FETCHES(B) N DST
S DST="CURR"
S ^TMP("BPSOS2",$J,"$H",DST)=$H
D FETCH58(DST_"(""COMM"")")
D FETSTAT(DST_"(""STAT"")")
;
;If entering option or resetting permanent values clear base
I B=0 K BASE S ^TMP("BPSOS2",$J,"$H","BASE")=$H
Q
;
DIFF ;EP - from BPSOS2A
N A,B S A=""
F S A=$O(CURR(A)) Q:A="" S B="" F S B=$O(CURR(A,B)) Q:B="" D
.I A="STAT" S CHG(A,B)=CURR(A,B)
.I A="COMM" S CHG(A,B)=CURR(A,B)-$G(BASE(A,B))
;
Q
;
FETCH58(DST) ; send DST = closed root of the destination
K @DST
N FN,DIC,DR,DA,DIQ,TMP ; note that DA=1 is hardcoded
S (FN,DIC)=9002313.58,DR="200:219",DIQ="TMP(",DA=1
D EN^DIQ1
M @DST=TMP(FN,1)
Q
;
FETSTAT(DEST) ;
; send DEST = closed root of the destination
K @DEST
N Q,N,A F Q=0:10:90,31 D
.S A="" F N=0:1 S A=$O(^BPST("AD",Q,A)) Q:A=""
. I Q#10 S @DEST@(Q\10*10)=@DEST@(Q\10*10)+N
. E S @DEST@(Q)=N ; relies on multiples of 10 coming first!
Q
;
UPDFREQ() ;
Q 3
;
CLEARAT() ;
S Y=$P(^BPSECX("S",1,0),U,2) X ^DD("DD") Q Y
;
HDR ; -- header code
S VALMHDR(1)="Communications statistics last cleared on "_$$CLEARAT
S XQORM("B")="U1" ; Default action is Update
Q
;
UPD ;EP - From BPSOS2A ; Protocol BPS P2 UPDATE
D UPDATE(1)
S VALMBCK="",XQORM("B")="U1"
Q
;
CONTUPD ; Protocol BPS P2 CONTINUOUS
W !!!!!
D UPDATE(-1)
S VALMBCK=""
Q
;
UPDATE(COUNTER) ; with COUNTER = a count down
N STOP,DTOUT
F D Q:$G(STOP)
.D UPD1
.S COUNTER=COUNTER-1 I 'COUNTER S STOP=1 Q
.I '$G(NODISPLY) D
..D MSG^VALM10("In continuous update mode: press Q to Quit")
..N X S X=$$READ^XGF(1,$$UPDFREQ) D MSG^VALM10(" ")
..I '$G(DTOUT),X]"","Qq^^"[X S STOP=1
..N Y F R Y:0 Q:'$T ; clean out typeahead (like mistaken arrow keys)
..; But if timed out, keep looping and updating
Q
;
UPD1 ; one update cycle
N A,B,T
D HDR,RE^VALM4
D FETCHES(1) ; fetch into CURR array
D DIFF ; compute differences
D VALUES^BPSOS2B ; compute values and display if changed
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D FULL^VALM1
Q
;
EXPND ; -- expand code
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOS2 3737 printed Apr 09, 2024@20:55:32 Page 2
BPSOS2 ;BHAM ISC/FCS/DRS - ECME manager's ScreenMan ;06/01/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; ECME Statistics Screen
+5 ; Called by option BPS STATISTICS
+6 ; Uses List Template BPS STATISTICS AND MANAGEMENT
+7 ; Original IHS logic had many management function, which are no
+8 ; longer used
+9 ;
+10 ; ALL writes of screen lines should be done as follows:
+11 ; IF $$VISIBLE(line) DO WRITE^VALM10(line)
+12 ; Then NODISPLY can be set so that $$VISIBLE always returns FALSE
+13 QUIT
+14 ;
EN ;EP - Option BPS STATISTICS
+1 NEW BASE,CURR,DISP,AVG,CHG
+2 ; BASE(*) = base values, from when zeroed things out
+3 ; CURR(*) = current values, from most recent read
+4 ; CHG(*) = changed value to print, if any
+5 ; fetch stats into CURR() array - possibly reset BASE array
DO FETCHES(0)
+6 MERGE CHG=CURR
+7 DO DIFF
+8 SET ^TMP("BPSOS2",$JOB,"FREQ")=30
+9 IF $PIECE($GET(^BPSECX("S",1,0)),U,2)=""
Begin DoDot:1
+10 NEW %,%H,%I,X
DO NOW^%DTC
SET $PIECE(^BPSECX("S",1,0),U,2)=%
End DoDot:1
+11 DO EN^VALM("BPS STATISTICS AND MANAGEMENT")
+12 QUIT
+13 ;
INIT ; Entry Code - Init variables and list array
+1 NEW NODISPLY
SET NODISPLY=1
+2 DO CLEAN^VALM10
+3 ; 0 lines so far
SET VALMCNT=0
+4 DO LABELS^BPSOS2C
+5 DO HDR
+6 ; set up CURR
DO FETCHES(1)
+7 MERGE CHG=CURR
+8 ; compute DIFF = differences and changed ones go into CHG
DO DIFF
+9 ; displays whatever's in CHG() and kills it off
DO VALUES^BPSOS2B
+10 QUIT
+11 ;
+12 ; Define Current (CURR) array and reset BASE
+13 ;
+14 ; Input variable -> B = 0 Reset (kill) BASE values and retrieve
+15 ; values
+16 ; 1 Just retrieve current values
FETCHES(B) NEW DST
+1 SET DST="CURR"
+2 SET ^TMP("BPSOS2",$JOB,"$H",DST)=$HOROLOG
+3 DO FETCH58(DST_"(""COMM"")")
+4 DO FETSTAT(DST_"(""STAT"")")
+5 ;
+6 ;If entering option or resetting permanent values clear base
+7 IF B=0
KILL BASE
SET ^TMP("BPSOS2",$JOB,"$H","BASE")=$HOROLOG
+8 QUIT
+9 ;
DIFF ;EP - from BPSOS2A
+1 NEW A,B
SET A=""
+2 FOR
SET A=$ORDER(CURR(A))
if A=""
QUIT
SET B=""
FOR
SET B=$ORDER(CURR(A,B))
if B=""
QUIT
Begin DoDot:1
+3 IF A="STAT"
SET CHG(A,B)=CURR(A,B)
+4 IF A="COMM"
SET CHG(A,B)=CURR(A,B)-$GET(BASE(A,B))
End DoDot:1
+5 ;
+6 QUIT
+7 ;
FETCH58(DST) ; send DST = closed root of the destination
+1 KILL @DST
+2 ; note that DA=1 is hardcoded
NEW FN,DIC,DR,DA,DIQ,TMP
+3 SET (FN,DIC)=9002313.58
SET DR="200:219"
SET DIQ="TMP("
SET DA=1
+4 DO EN^DIQ1
+5 MERGE @DST=TMP(FN,1)
+6 QUIT
+7 ;
FETSTAT(DEST) ;
+1 ; send DEST = closed root of the destination
+2 KILL @DEST
+3 NEW Q,N,A
FOR Q=0:10:90,31
Begin DoDot:1
+4 SET A=""
FOR N=0:1
SET A=$ORDER(^BPST("AD",Q,A))
if A=""
QUIT
+5 IF Q#10
SET @DEST@(Q\10*10)=@DEST@(Q\10*10)+N
+6 ; relies on multiples of 10 coming first!
IF '$TEST
SET @DEST@(Q)=N
End DoDot:1
+7 QUIT
+8 ;
UPDFREQ() ;
+1 QUIT 3
+2 ;
CLEARAT() ;
+1 SET Y=$PIECE(^BPSECX("S",1,0),U,2)
XECUTE ^DD("DD")
QUIT Y
+2 ;
HDR ; -- header code
+1 SET VALMHDR(1)="Communications statistics last cleared on "_$$CLEARAT
+2 ; Default action is Update
SET XQORM("B")="U1"
+3 QUIT
+4 ;
UPD ;EP - From BPSOS2A ; Protocol BPS P2 UPDATE
+1 DO UPDATE(1)
+2 SET VALMBCK=""
SET XQORM("B")="U1"
+3 QUIT
+4 ;
CONTUPD ; Protocol BPS P2 CONTINUOUS
+1 WRITE !!!!!
+2 DO UPDATE(-1)
+3 SET VALMBCK=""
+4 QUIT
+5 ;
UPDATE(COUNTER) ; with COUNTER = a count down
+1 NEW STOP,DTOUT
+2 FOR
Begin DoDot:1
+3 DO UPD1
+4 SET COUNTER=COUNTER-1
IF 'COUNTER
SET STOP=1
QUIT
+5 IF '$GET(NODISPLY)
Begin DoDot:2
+6 DO MSG^VALM10("In continuous update mode: press Q to Quit")
+7 NEW X
SET X=$$READ^XGF(1,$$UPDFREQ)
DO MSG^VALM10(" ")
+8 IF '$GET(DTOUT)
IF X]""
IF "Qq^^"[X
SET STOP=1
+9 ; clean out typeahead (like mistaken arrow keys)
NEW Y
FOR
READ Y:0
if '$TEST
QUIT
+10 ; But if timed out, keep looping and updating
End DoDot:2
End DoDot:1
if $GET(STOP)
QUIT
+11 QUIT
+12 ;
UPD1 ; one update cycle
+1 NEW A,B,T
+2 DO HDR
DO RE^VALM4
+3 ; fetch into CURR array
DO FETCHES(1)
+4 ; compute differences
DO DIFF
+5 ; compute values and display if changed
DO VALUES^BPSOS2B
+6 QUIT
+7 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO FULL^VALM1
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
