IBPU.m

IBPU	;ALB/CPM - ARCHIVE/PURGING UTILITIES ; 20-APR-92

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;;Per VHA Directive 10-93-142, this routine should not be modified.

	;

ASK(FILE,JOB)	; User prompts to find/archive/purge entries for each data file.

	;         Input:  FILE -- Billing Data file number

	;                  JOB --  1  Find Billing Data to Archive

	;                      --  2  Archive Billing Data

	;                      --  3  Purge Billing Data

	;         Output:  -1  -- Exit option

	;                  0   -- No action to be taken

	;                  1^a -- Take action.

	;                          Optional second piece (a) is ien of

	;                          log entry if a restart is required.

	N FNAME,STATUS,Y

	S STATUS=$$LOG($G(FILE)) I 'STATUS W !,"File #",FILE," is not defined." Q 0

	S FNAME=$P($G(^DIC(FILE,0)),"^")

	I (JOB=2&(STATUS=1))!(JOB=3&(STATUS<3)) W !,"You must ",$S(STATUS=1:"find ",1:"archive "),FNAME," entries before you can ",$S(JOB=2:"archive.",1:"purge.") Q 0

	S STATUS=STATUS-JOB+1

	Q $S(STATUS>1:$$RESTART(FNAME,FILE,JOB),1:$$START(FNAME,JOB))

	;

START(NAME,JOB)	; Start find/archive/purge action?

	;         Input:  NAME -- File name

	;                  JOB -- same as above (1, 2, or 3)

	;         Output:    1 -- Yes,   0 -- No,  -1 -- Exit Option

	N DESC,DIR,DIRUT,DUOUT,DTOUT,Y

	S DESC=$P("find^archive^purge","^",JOB)

	S DIR(0)="Y",DIR("A")="Do you wish to "_DESC_" "_NAME_" file entries"

	S DIR("?",1)="Enter:  'Y'  to "_DESC_" "_NAME_" entries"

	S DIR("?",2)="        'N'  to ignore "_$P("find^archiv^purg","^",JOB)_"ing "_NAME_" entries, or"

	S DIR("?")="        '^'  to quit this option." D ^DIR

	Q $S($D(DIRUT)!($D(DUOUT))!($D(DTOUT)):-1,Y:1,1:0)

	;

RESTART(NAME,FILE,JOB)	; Re-start find/archive action?

	;         Input:  NAME -- File name

	;                 FILE -- Billing Data file number

	;                  JOB -- same as above (only 1 or 2)

	;         Output:    1 -- Yes,   0 -- No,  -1 -- Exit Option

	N DIR,DIRUT,DUOUT,DTOUT,Y

	W !,NAME," file entries have already been ",$P("found.^archived.","^",JOB)

	S DIR(0)="Y",DIR("A")="Do you wish to "_$S(JOB=1:"delete your search template and start",1:"archive these entries")_" again"

	S DIR("?",1)="Enter:  'Y'  to "_$S(JOB=1:"delete your current search template and search",1:"archive entries")_" again"

	S DIR("?",2)="        'N'  to "_$S(JOB=1:"retain your current search template",1:"ignore archiving this file")_", or"

	S DIR("?")="        '^'  to quit this option." D ^DIR

	Q $S($D(DIRUT)!($D(DUOUT))!($D(DTOUT)):-1,Y:"1^"_$$LOGIEN^IBPU1(FILE),1:0)

	;

LOG(FILE)	; Determine Log status for a file.

	;         Input:  FILE -- Billing Data file number

	;         Output:  0   -- File undefined, or invalid file number

	;                  1   -- No active log entry on file

	;                  2   -- Active log entry on file - entries FOUND

	;                  3   -- Active log entry on file - entries ARCHIVED

	N Y,LOG,LOG1,LOG2

	I '$D(^DIC(+$G(FILE))) S Y=0 G LOGQ

	S DA=$$LOGIEN^IBPU1(FILE)

	S LOG=$G(^IBE(350.6,DA,0)),LOG1=$G(^(1)),LOG2=$G(^(2))

	I $P(LOG,"^",5)'=1 S Y=1

LOGQ	Q $S($D(Y):Y,$P(LOG2,"^",2):3,$P(LOG1,"^",2):2,1:1)

	;

NUM()	; How many previous fiscal year's worth of data should be retained?

	; Input:  NONE    Output:  number of years, or  -1  to exit option.

	N DIR,DIRUT,DUOUT,DTOUT,Y

	S DIR("A")="Select the number of previous fiscal year's data to retain: "

	S DIR("?",1)="Please select the number of previous fiscal years' worth of billing"

	S DIR("?")="data that you wish to retain in your system, or '^' to exit."

	S DIR(0)="NA^1:20:0",DIR("B")=1 D ^DIR

	Q $S($D(DIRUT)!($D(DUOUT))!($D(DTOUT)):-1,1:Y)

	;

DAT()	; What is the date through which data should be archived?

	; Input:  NONE    Output:  final date for archiving, or  -1  to exit.

	N %DT,DTOUT,X,Y

	S %DT="AEPX",%DT(0)=-$$LAST^IBPFU(1),%DT("A")="Enter the final date through which data should be archived: "

	D ^%DT

	Q Y

IBPU      ;ALB/CPM - ARCHIVE/PURGING UTILITIES ; 20-APR-92

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

ASK(FILE,JOB) ; User prompts to find/archive/purge entries for each data file.

 +1       ;         Input:  FILE -- Billing Data file number

 +2       ;                  JOB --  1  Find Billing Data to Archive

 +3       ;                      --  2  Archive Billing Data

 +4       ;                      --  3  Purge Billing Data

 +5       ;         Output:  -1  -- Exit option

 +6       ;                  0   -- No action to be taken

 +7       ;                  1^a -- Take action.

 +8       ;                          Optional second piece (a) is ien of

 +9       ;                          log entry if a restart is required.

 +10       NEW FNAME,STATUS,Y

 +11       SET STATUS=$$LOG($GET(FILE))

           IF 'STATUS

               WRITE !,"File #",FILE," is not defined."

               QUIT 0

 +12       SET FNAME=$PIECE($GET(^DIC(FILE,0)),"^")

 +13       IF (JOB=2&(STATUS=1))!(JOB=3&(STATUS<3))

               WRITE !,"You must ",$SELECT(STATUS=1:"find ",1:"archive "),FNAME," entries before you can ",$SELECT(JOB=2:"archive.",1:"purge.")

               QUIT 0

 +14       SET STATUS=STATUS-JOB+1

 +15       QUIT $SELECT(STATUS>1:$$RESTART(FNAME,FILE,JOB),1:$$START(FNAME,JOB))

 +16      ;

START(NAME,JOB) ; Start find/archive/purge action?

 +1       ;         Input:  NAME -- File name

 +2       ;                  JOB -- same as above (1, 2, or 3)

 +3       ;         Output:    1 -- Yes,   0 -- No,  -1 -- Exit Option

 +4        NEW DESC,DIR,DIRUT,DUOUT,DTOUT,Y

 +5        SET DESC=$PIECE("find^archive^purge","^",JOB)

 +6        SET DIR(0)="Y"

           SET DIR("A")="Do you wish to "_DESC_" "_NAME_" file entries"

 +7        SET DIR("?",1)="Enter:  'Y'  to "_DESC_" "_NAME_" entries"

 +8        SET DIR("?",2)="        'N'  to ignore "_$PIECE("find^archiv^purg","^",JOB)_"ing "_NAME_" entries, or"

 +9        SET DIR("?")="        '^'  to quit this option."

           DO ^DIR

 +10       QUIT $SELECT($DATA(DIRUT)!($DATA(DUOUT))!($DATA(DTOUT)):-1,Y:1,1:0)

 +11      ;

RESTART(NAME,FILE,JOB) ; Re-start find/archive action?

 +1       ;         Input:  NAME -- File name

 +2       ;                 FILE -- Billing Data file number

 +3       ;                  JOB -- same as above (only 1 or 2)

 +4       ;         Output:    1 -- Yes,   0 -- No,  -1 -- Exit Option

 +5        NEW DIR,DIRUT,DUOUT,DTOUT,Y

 +6        WRITE !,NAME," file entries have already been ",$PIECE("found.^archived.","^",JOB)

 +7        SET DIR(0)="Y"

           SET DIR("A")="Do you wish to "_$SELECT(JOB=1:"delete your search template and start",1:"archive these entries")_" again"

 +8        SET DIR("?",1)="Enter:  'Y'  to "_$SELECT(JOB=1:"delete your current search template and search",1:"archive entries")_" again"

 +9        SET DIR("?",2)="        'N'  to "_$SELECT(JOB=1:"retain your current search template",1:"ignore archiving this file")_", or"

 +10       SET DIR("?")="        '^'  to quit this option."

           DO ^DIR

 +11       QUIT $SELECT($DATA(DIRUT)!($DATA(DUOUT))!($DATA(DTOUT)):-1,Y:"1^"_$$LOGIEN^IBPU1(FILE),1:0)

 +12      ;

LOG(FILE) ; Determine Log status for a file.

 +1       ;         Input:  FILE -- Billing Data file number

 +2       ;         Output:  0   -- File undefined, or invalid file number

 +3       ;                  1   -- No active log entry on file

 +4       ;                  2   -- Active log entry on file - entries FOUND

 +5       ;                  3   -- Active log entry on file - entries ARCHIVED

 +6        NEW Y,LOG,LOG1,LOG2

 +7        IF '$DATA(^DIC(+$GET(FILE)))

               SET Y=0

               GOTO LOGQ

 +8        SET DA=$$LOGIEN^IBPU1(FILE)

 +9        SET LOG=$GET(^IBE(350.6,DA,0))

           SET LOG1=$GET(^(1))

           SET LOG2=$GET(^(2))

 +10       IF $PIECE(LOG,"^",5)'=1

               SET Y=1

LOGQ       QUIT $SELECT($DATA(Y):Y,$PIECE(LOG2,"^",2):3,$PIECE(LOG1,"^",2):2,1:1)

 +1       ;

NUM()     ; How many previous fiscal year's worth of data should be retained?

 +1       ; Input:  NONE    Output:  number of years, or  -1  to exit option.

 +2        NEW DIR,DIRUT,DUOUT,DTOUT,Y

 +3        SET DIR("A")="Select the number of previous fiscal year's data to retain: "

 +4        SET DIR("?",1)="Please select the number of previous fiscal years' worth of billing"

 +5        SET DIR("?")="data that you wish to retain in your system, or '^' to exit."

 +6        SET DIR(0)="NA^1:20:0"

           SET DIR("B")=1

           DO ^DIR

 +7        QUIT $SELECT($DATA(DIRUT)!($DATA(DUOUT))!($DATA(DTOUT)):-1,1:Y)

 +8       ;

DAT()     ; What is the date through which data should be archived?

 +1       ; Input:  NONE    Output:  final date for archiving, or  -1  to exit.

 +2        NEW %DT,DTOUT,X,Y

 +3        SET %DT="AEPX"

           SET %DT(0)=-$$LAST^IBPFU(1)

           SET %DT("A")="Enter the final date through which data should be archived: "

 +4        DO ^%DT

 +5        QUIT Y