Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSOS2

BPSOS2.m

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