- 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 Jan 18, 2025@02:52:41 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