| 1 | BPSOS2A ;BHAM ISC/FCS/DRS/DLF - continuation of BPSOS2 ;06/01/2004
|
|---|
| 2 | ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;Statistics & Misc Options Screen - Zero Stats
|
|---|
| 6 | ;
|
|---|
| 7 | ;Protocol - BPS P2 ZERO - clearing stats
|
|---|
| 8 | ZERO N ZTYP,X
|
|---|
| 9 | S ZTYP=$$SELZTYP() I ZTYP="^" W !!!,"Nothing changed.",! D ANY
|
|---|
| 10 | I ZTYP'="^" D
|
|---|
| 11 | .I $$SURE'=1 W !!!,"Nothing changed.",! D ANY Q
|
|---|
| 12 | .;
|
|---|
| 13 | .;Clear Local Stats
|
|---|
| 14 | .I ZTYP=0 D ZLOCAL
|
|---|
| 15 | .;
|
|---|
| 16 | .;Clear Permanent Stats
|
|---|
| 17 | .I ZTYP=1 D ZPERM,FETCHES^BPSOS2(0) ; fetch all these zeroes into BASE(*)
|
|---|
| 18 | D UPD^BPSOS2
|
|---|
| 19 | S VALMBCK=""
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | ;Zero Local Statistics
|
|---|
| 23 | ;
|
|---|
| 24 | ;Reset Base Numbers to Current Numbers
|
|---|
| 25 | ZLOCAL K BASE M BASE=CURR
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | ;Zero Permanent Statistics
|
|---|
| 29 | ; This logic will create a strange order - Record 1 is always the newest.
|
|---|
| 30 | ; Record 2 will be the oldest, Record 3 is next oldest, etc.
|
|---|
| 31 | ZPERM N FILE
|
|---|
| 32 | S FILE=9002313.58
|
|---|
| 33 | L +^BPSECX("S"):300 I '$T W "LOCK failed",! Q
|
|---|
| 34 | ;
|
|---|
| 35 | ; Increment zero node for the database
|
|---|
| 36 | N I,N
|
|---|
| 37 | F I=3,4 D
|
|---|
| 38 | . S N=$P(^BPSECX("S",0),U,I)+1
|
|---|
| 39 | . S $P(^BPSECX("S",0),U,I)=N
|
|---|
| 40 | ;
|
|---|
| 41 | ; Merge current data into new record
|
|---|
| 42 | S N=$P(^BPSECX("S",0),U,3)
|
|---|
| 43 | M ^BPSECX("S",N)=^BPSECX("S",1)
|
|---|
| 44 | S $P(^BPSECX("S",N,0),U)=N ; fix up the .01 field
|
|---|
| 45 | N DIK,DA S DIK="^BPSECX(""S"",",DA=N D IX^DIK ; trivial indexing
|
|---|
| 46 | ;
|
|---|
| 47 | ; Update fields to be zero, except date/time cleared
|
|---|
| 48 | N FIELD S FIELD=.01
|
|---|
| 49 | F S FIELD=$O(^DD(FILE,FIELD)) Q:'FIELD D
|
|---|
| 50 | . N VALUE
|
|---|
| 51 | . I FIELD=2 D ; date/time last cleared
|
|---|
| 52 | .. N %,%H,%I,X D NOW^%DTC S VALUE=%
|
|---|
| 53 | . E S VALUE=0
|
|---|
| 54 | . N DIE,DA,DR S DIE=FILE,DA=1,DR=FIELD_"////"_VALUE D ^DIE
|
|---|
| 55 | ;
|
|---|
| 56 | ; Unlock record
|
|---|
| 57 | L -^BPSECX("S")
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | SELZTYP() ;
|
|---|
| 61 | N DFLT,DIR,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 62 | S DFLT="Local Copy"
|
|---|
| 63 | 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
|
|---|
| 64 | D ^DIR
|
|---|
| 65 | I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
|
|---|
| 66 | S Y=$S(Y="P":1,Y="L":0,1:Y)
|
|---|
| 67 | Q Y
|
|---|
| 68 | ;
|
|---|
| 69 | SURE(DEF) ;
|
|---|
| 70 | N SURE,PMT,OPT,ANS
|
|---|
| 71 | S PMT="Are you sure"
|
|---|
| 72 | I '$D(DEF) S DEF="N"
|
|---|
| 73 | S OPT=1 ; answer is optional
|
|---|
| 74 | S ANS=$$YESNO^BPSOSU3(PMT,DEF,OPT)
|
|---|
| 75 | Q ANS ; 1 or 0 or -1 or ^ or ^^ or null
|
|---|
| 76 | ANY ;EP
|
|---|
| 77 | W:$X ! D PRESSANY^BPSOSU5() Q ; Press any key
|
|---|
