VistA-FOIAVistA/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHLO.m

147 lines
4.5 KiB
Mathematica

PRCHLO ;WOIFO/RLL-EXTRACT ROUTINE CLO REPORT SERVER ; 7/31/06 12:33pm
V ;;5.1;IFCAP;**83,104**; Oct 20, 2000
; Per VHA Directive 10-93-142, this routine should not be modified
;
; PRCHLO* routines are used to build the extract files from
; file 442 for the clinical logistics report server.
; PRCHLO thru PRCHLO5 perform the following:
; 1. Initialize environment
; 2. Get parameters for the month being run
; 3. Pull data from file 442 for month being run
; 4. Create multiple "^" delimited flat files for report server
; 5. At the completion of extracts FTP files to report server
; 6. Clean up / remove any temp files
; 7. logout
; CALC is the programmer entry point used to test the extract
; options for the first iteration of coding
;
Q
INIT ; Initialize environment
;
;
; Get todays date
N %
S %=$P(($$NOW^XLFDT),".",1)
; (old logic)
; Always start from the 1st of the month to the end of month
; and at least 45 days prior to todays date
;
; (new logic)
; Always start from the beginning of the Fiscal Year and run
; the extract up until the Date of the extract run (NOW)
;
; The CALC entry point is used for testing from programmer mode
; and allows the programmer to pass a specific date
; in the variable %=FM date format
;
CALC ;test entry point, set %I to FM date
;
N CLO1,CLO2,CLO2B,CLO2E,CLO3,CLOBGN,CLOEND,POND1,POND2,CLO1A
N MTHRUN,YRRUN,PYRRUN
S CLO1=$E(%,1,3)
;
S CLO2=$E(%,4,5)
S YRRUN=+(CLO1)
S PYRRUN=YRRUN-1 ; previous Year Run
S MTHRUN=+(CLO2)
I +CLO2>2 D
. S CLO2B=CLO2-2
. I $L(CLO2B)<2 S CLO2B=0_CLO2B
. S CLO2E=CLO2-1
. I $L(CLO2E)<2 S CLO2E=0_CLO2E
. S CLOBGN=+(CLO1_(CLO2B)_"00")
. S CLOEND=+(CLO1_(CLO2E)_"01")
. Q
;
; check for January run, and Feb run
I +CLO2=1 D
. S CLO1=CLO1-1
. S CLOBGN=+(CLO1_11_"00") ; Start date is Nov 1st
. S CLOEND=+(CLO1_12_"01") ; End date is Dec 1st
. Q
I +CLO2=2 D
. S CLO1A=CLO1-1 ; Need to get Dec, previous year
. S CLOBGN=+(CLO1A_12_"00") ; Start date is Dec 1st
. S CLOEND=+(CLO1_"01"_"01") ; End date is Jan 1st
. Q
;
; (Begin new logic)
FYRNOW ; Changes added 07/31/06 RLL for new extract date range.
; CLOBGN will always be the beginning of the Fiscal Year (Oct 1st)
; This will be the start range for each extract.
; This routine is called through the option :
; [PRCHLO CLO PROCUREMENT] which is queued to run in TaskMan
; This option should be queued to run 2 hours AFTER
; [PRCHLO GIP OPTION] and should be run on the same day
; (after midnight) as the [PRCHLO GIP OPTION]. As an example:
; 1. Que [PRCHLO GIP OPTION] to run 12:00am the 1st of the month
; 2. Que [PRCHLO CLO PROCUREMENT] to run 1:00am the 1st of the month
;
;
; The following new Variables were added to the CALC entry point:
; YRRUN ; year option run
; PYRRUN ; previous year option run
; MTHRUN ; MONTHRUN
; listed below are 3 examples:
;
; Month Option Run | Date Range for Run | # of months of data
; Dec 1st, 2005 | Oct 1, 2005 to Dec 1st 2005| 2
; Apr 1st, 2006 | Oct 1, 2005 to Apr 1st 2006| 6
; Oct 1st, 2006 | Oct 1, 2005 to Oct 1st 2006| 12
;
STCLOBGN ; Set CLOBGN to Beginning of Fiscal Year (Oct. 1)
;
I MTHRUN=12!(MTHRUN=11) D
. ; For Nov or Dec, CLOBGN set to Begin of FY(Oct 1st) in same year
. S CLOBGN=+(YRRUN_"10"_"00")
. S CLOEND=% ; CLOEND is Date Extract Run
. Q
I (MTHRUN<11) D ; (CLOBGN set to Prev FY for all other conditions)
. S CLOBGN=+(PYRRUN_"10"_"00")
. S CLOEND=% ; CLOEND is Date Extract Run
. Q
; (End new logic)
;
DEBUGFY ; Debug Fiscal Year logic by uncommenting code below 7/31/06 RLL
; W !,"CLOBGN is ",CLOBGN," CLOEND is ",CLOEND,! ; Write date range
; Q ; Quit added here for debugging 7/31/06 RLL
;
D GPARM
; Make sure ^TMP($J) is set with data, otherwise return error
N CKTP
S CKTP=$O(^TMP($J,0))
I CKTP="" D
. S CLRSERR=1 ; error flag indicates no data in ^TMP($J)
. Q
Q
;
GPARM ; Get parameters for monthly extract
;
; need to set monthyear for data file
;
N MNTHYR,FMDT1,MYRVAL
S FMDT1=$P(($$NOW^XLFDT),".",1)
S MYRVAL=$$FMTE^XLFDT(FMDT1)
S MNTHYR=$P(MYRVAL," ",1)_","_$P(MYRVAL," ",3)
;
; $O through the "AB" x-ref based on CLOBGN and CLOEND
;
S CLO1=CLOBGN,CLO2="",CLO3=""
F S CLO1=$O(^PRC(442,"AB",CLO1)) Q:CLO1="" D
. F S CLO2=$O(^PRC(442,"AB",CLO1,CLO2)) Q:CLO2="" D
. . Q:CLO1>(CLOEND-1)
. . D GKEY
. . Q
. Q
Q
EXTR ; Extract the data, create files
;
GKEY ; get key for all tables
N POID,POND0,POND1,POCRDAT
S POND0=$G(^PRC(442,CLO2,0))
S POND1=$G(^PRC(442,CLO2,1))
S POID=CLO2
S POCRDAT=CLO1 ; PO Date from x-ref value
D GPOMAST^PRCHLO1 ;
Q