source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOS2A.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1BPSOS2A ;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
8ZERO 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
25ZLOCAL 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.
31ZPERM 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 ;
60SELZTYP() ;
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 ;
69SURE(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
76ANY ;EP
77 W:$X ! D PRESSANY^BPSOSU5() Q ; Press any key
Note: See TracBrowser for help on using the repository browser.