BPSOS2A ;BHAM ISC/FCS/DRS/DLF - continuation of BPSOS2 ;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.
Q
;Statistics & Misc Options Screen - Zero Stats
;
;Protocol - BPS P2 ZERO - clearing stats
ZERO N ZTYP,X
S ZTYP=$$SELZTYP() I ZTYP="^" W !!!,"Nothing changed.",! D ANY
I ZTYP'="^" D
.I $$SURE'=1 W !!!,"Nothing changed.",! D ANY Q
.;
.;Clear Local Stats
.I ZTYP=0 D ZLOCAL
.;
.;Clear Permanent Stats
.I ZTYP=1 D ZPERM,FETCHES^BPSOS2(0) ; fetch all these zeroes into BASE(*)
D UPD^BPSOS2
S VALMBCK=""
Q
;
;Zero Local Statistics
;
;Reset Base Numbers to Current Numbers
ZLOCAL K BASE M BASE=CURR
Q
;
;Zero Permanent Statistics
; This logic will create a strange order - Record 1 is always the newest.
; Record 2 will be the oldest, Record 3 is next oldest, etc.
ZPERM N FILE
S FILE=9002313.58
L +^BPSECX("S"):300 I '$T W "LOCK failed",! Q
;
; Increment zero node for the database
N I,N
F I=3,4 D
. S N=$P(^BPSECX("S",0),U,I)+1
. S $P(^BPSECX("S",0),U,I)=N
;
; Merge current data into new record
S N=$P(^BPSECX("S",0),U,3)
M ^BPSECX("S",N)=^BPSECX("S",1)
S $P(^BPSECX("S",N,0),U)=N ; fix up the .01 field
N DIK,DA S DIK="^BPSECX(""S"",",DA=N D IX^DIK ; trivial indexing
;
; Update fields to be zero, except date/time cleared
N FIELD S FIELD=.01
F S FIELD=$O(^DD(FILE,FIELD)) Q:'FIELD D
. N VALUE
. I FIELD=2 D ; date/time last cleared
.. N %,%H,%I,X D NOW^%DTC S VALUE=%
. E S VALUE=0
. N DIE,DA,DR S DIE=FILE,DA=1,DR=FIELD_"////"_VALUE D ^DIE
;
; Unlock record
L -^BPSECX("S")
Q
;
SELZTYP() ;
N DFLT,DIR,DIRUT,DTOUT,DUOUT,X,Y
S DFLT="Local Copy"
S DIR(0)="S^L:Local Copy;P:Permanent Copy",DIR("A")="Delete (L)ocal Copy or (P)ermanent Copy of the statistics",DIR("B")=DFLT
D ^DIR
I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
S Y=$S(Y="P":1,Y="L":0,1:Y)
Q Y
;
SURE(DEF) ;
N SURE,PMT,OPT,ANS
S PMT="Are you sure"
I '$D(DEF) S DEF="N"
S OPT=1 ; answer is optional
S ANS=$$YESNO^BPSOSU3(PMT,DEF,OPT)
Q ANS ; 1 or 0 or -1 or ^ or ^^ or null
ANY ;EP
W:$X ! D PRESSANY^BPSOSU5() Q ; Press any key
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOS2A 2219 printed Apr 09, 2024@20:57:57 Page 2
BPSOS2A ;BHAM ISC/FCS/DRS/DLF - continuation of BPSOS2 ;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 QUIT
+4 ;Statistics & Misc Options Screen - Zero Stats
+5 ;
+6 ;Protocol - BPS P2 ZERO - clearing stats
ZERO NEW ZTYP,X
+1 SET ZTYP=$$SELZTYP()
IF ZTYP="^"
WRITE !!!,"Nothing changed.",!
DO ANY
+2 IF ZTYP'="^"
Begin DoDot:1
+3 IF $$SURE'=1
WRITE !!!,"Nothing changed.",!
DO ANY
QUIT
+4 ;
+5 ;Clear Local Stats
+6 IF ZTYP=0
DO ZLOCAL
+7 ;
+8 ;Clear Permanent Stats
+9 ; fetch all these zeroes into BASE(*)
IF ZTYP=1
DO ZPERM
DO FETCHES^BPSOS2(0)
End DoDot:1
+10 DO UPD^BPSOS2
+11 SET VALMBCK=""
+12 QUIT
+13 ;
+14 ;Zero Local Statistics
+15 ;
+16 ;Reset Base Numbers to Current Numbers
ZLOCAL KILL BASE
MERGE BASE=CURR
+1 QUIT
+2 ;
+3 ;Zero Permanent Statistics
+4 ; This logic will create a strange order - Record 1 is always the newest.
+5 ; Record 2 will be the oldest, Record 3 is next oldest, etc.
ZPERM NEW FILE
+1 SET FILE=9002313.58
+2 LOCK +^BPSECX("S"):300
IF '$TEST
WRITE "LOCK failed",!
QUIT
+3 ;
+4 ; Increment zero node for the database
+5 NEW I,N
+6 FOR I=3,4
Begin DoDot:1
+7 SET N=$PIECE(^BPSECX("S",0),U,I)+1
+8 SET $PIECE(^BPSECX("S",0),U,I)=N
End DoDot:1
+9 ;
+10 ; Merge current data into new record
+11 SET N=$PIECE(^BPSECX("S",0),U,3)
+12 MERGE ^BPSECX("S",N)=^BPSECX("S",1)
+13 ; fix up the .01 field
SET $PIECE(^BPSECX("S",N,0),U)=N
+14 ; trivial indexing
NEW DIK,DA
SET DIK="^BPSECX(""S"","
SET DA=N
DO IX^DIK
+15 ;
+16 ; Update fields to be zero, except date/time cleared
+17 NEW FIELD
SET FIELD=.01
+18 FOR
SET FIELD=$ORDER(^DD(FILE,FIELD))
if 'FIELD
QUIT
Begin DoDot:1
+19 NEW VALUE
+20 ; date/time last cleared
IF FIELD=2
Begin DoDot:2
+21 NEW %,%H,%I,X
DO NOW^%DTC
SET VALUE=%
End DoDot:2
+22 IF '$TEST
SET VALUE=0
+23 NEW DIE,DA,DR
SET DIE=FILE
SET DA=1
SET DR=FIELD_"////"_VALUE
DO ^DIE
End DoDot:1
+24 ;
+25 ; Unlock record
+26 LOCK -^BPSECX("S")
+27 QUIT
+28 ;
SELZTYP() ;
+1 NEW DFLT,DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DFLT="Local Copy"
+3 SET DIR(0)="S^L:Local Copy;P:Permanent Copy"
SET DIR("A")="Delete (L)ocal Copy or (P)ermanent Copy of the statistics"
SET DIR("B")=DFLT
+4 DO ^DIR
+5 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET Y="^"
+6 SET Y=$SELECT(Y="P":1,Y="L":0,1:Y)
+7 QUIT Y
+8 ;
SURE(DEF) ;
+1 NEW SURE,PMT,OPT,ANS
+2 SET PMT="Are you sure"
+3 IF '$DATA(DEF)
SET DEF="N"
+4 ; answer is optional
SET OPT=1
+5 SET ANS=$$YESNO^BPSOSU3(PMT,DEF,OPT)
+6 ; 1 or 0 or -1 or ^ or ^^ or null
QUIT ANS
ANY ;EP
+1 ; Press any key
if $X
WRITE !
DO PRESSANY^BPSOSU5()
QUIT
