BPSOS2A.m

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 ---BPSOS2A   2219     printed  Mar 13, 2025@20:56:09                                                                                                                                                                                                     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