- PRCHLO ;WOIFO/RLL-EXTRACT ROUTINE CLO REPORT SERVER ;12/30/10 14:34
- ;;5.1;IFCAP;**83,104,130,154**;Oct 20, 2000;Build 5
- ; Per VHA Directive 2004-038, this routine should not be modified
- ;
- ; PRCHLO* routines are used to build the extract files from
- ; file 410, 424, and 442 for the clinical logistics report server.
- ; PRCHLO thru PRCHLO6 perform the following:
- ; 1. Initialize environment
- ; 2. Get parameters for the month being run
- ; 3. Pull data from file 410, 424, and 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
- ;
- K ^TMP($J)
- ;
- ; 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,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
- ;
- 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
- ; PRC*5.1*130 begin
- D GET410^PRCHLO6
- D GET424^PRCHLO6
- ; PRC*5.1*130 end
- D INVCOMPL^PRCHLO7 ;Compile Invoice Tracking
- Q
- EXTR ; Extract the data, create files
- ;
- GKEY ; get key for all tables
- N POID,POCRDAT
- S POID=CLO2
- S POCRDAT=CLO1 ; PO Date from x-ref value
- D GPOMAST^PRCHLO1 ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHLO 4766 printed Feb 18, 2025@23:34:49 Page 2
- PRCHLO ;WOIFO/RLL-EXTRACT ROUTINE CLO REPORT SERVER ;12/30/10 14:34
- +1 ;;5.1;IFCAP;**83,104,130,154**;Oct 20, 2000;Build 5
- +2 ; Per VHA Directive 2004-038, this routine should not be modified
- +3 ;
- +4 ; PRCHLO* routines are used to build the extract files from
- +5 ; file 410, 424, and 442 for the clinical logistics report server.
- +6 ; PRCHLO thru PRCHLO6 perform the following:
- +7 ; 1. Initialize environment
- +8 ; 2. Get parameters for the month being run
- +9 ; 3. Pull data from file 410, 424, and 442 for month being run
- +10 ; 4. Create multiple "^" delimited flat files for report server
- +11 ; 5. At the completion of extracts FTP files to report server
- +12 ; 6. Clean up / remove any temp files
- +13 ; 7. logout
- +14 ; CALC is the programmer entry point used to test the extract
- +15 ; options for the first iteration of coding
- +16 ;
- +17 QUIT
- INIT ; Initialize environment
- +1 ;
- +2 KILL ^TMP($JOB)
- +3 ;
- +4 ; Get todays date
- +5 NEW %
- +6 SET %=$PIECE(($$NOW^XLFDT),".",1)
- +7 ; (old logic)
- +8 ; Always start from the 1st of the month to the end of month
- +9 ; and at least 45 days prior to todays date
- +10 ;
- +11 ; (new logic)
- +12 ; Always start from the beginning of the Fiscal Year and run
- +13 ; the extract up until the Date of the extract run (NOW)
- +14 ;
- +15 ; The CALC entry point is used for testing from programmer mode
- +16 ; and allows the programmer to pass a specific date
- +17 ; in the variable %=FM date format
- +18 ;
- CALC ;test entry point, set %I to FM date
- +1 ;
- +2 NEW CLO1,CLO2,CLO2B,CLO2E,CLO3,CLOBGN,CLOEND,CLO1A
- +3 NEW MTHRUN,YRRUN,PYRRUN
- +4 SET CLO1=$EXTRACT(%,1,3)
- +5 ;
- +6 SET CLO2=$EXTRACT(%,4,5)
- +7 SET YRRUN=+(CLO1)
- +8 ; previous Year Run
- SET PYRRUN=YRRUN-1
- +9 SET MTHRUN=+(CLO2)
- +10 IF +CLO2>2
- Begin DoDot:1
- +11 SET CLO2B=CLO2-2
- +12 IF $LENGTH(CLO2B)<2
- SET CLO2B=0_CLO2B
- +13 SET CLO2E=CLO2-1
- +14 IF $LENGTH(CLO2E)<2
- SET CLO2E=0_CLO2E
- +15 SET CLOBGN=+(CLO1_(CLO2B)_"00")
- +16 SET CLOEND=+(CLO1_(CLO2E)_"01")
- +17 QUIT
- End DoDot:1
- +18 ;
- +19 ; check for January run, and Feb run
- +20 IF +CLO2=1
- Begin DoDot:1
- +21 SET CLO1=CLO1-1
- +22 ; Start date is Nov 1st
- SET CLOBGN=+(CLO1_11_"00")
- +23 ; End date is Dec 1st
- SET CLOEND=+(CLO1_12_"01")
- +24 QUIT
- End DoDot:1
- +25 IF +CLO2=2
- Begin DoDot:1
- +26 ; Need to get Dec, previous year
- SET CLO1A=CLO1-1
- +27 ; Start date is Dec 1st
- SET CLOBGN=+(CLO1A_12_"00")
- +28 ; End date is Jan 1st
- SET CLOEND=+(CLO1_"01"_"01")
- +29 QUIT
- End DoDot:1
- +30 ;
- +31 ; (Begin new logic)
- FYRNOW ; Changes added 07/31/06 RLL for new extract date range.
- +1 ; CLOBGN will always be the beginning of the Fiscal Year (Oct 1st)
- +2 ; This will be the start range for each extract.
- +3 ; This routine is called through the option :
- +4 ; [PRCHLO CLO PROCUREMENT] which is queued to run in TaskMan
- +5 ; This option should be queued to run 2 hours AFTER
- +6 ; [PRCHLO GIP OPTION] and should be run on the same day
- +7 ; (after midnight) as the [PRCHLO GIP OPTION]. As an example:
- +8 ; 1. Que [PRCHLO GIP OPTION] to run 12:00am the 1st of the month
- +9 ; 2. Que [PRCHLO CLO PROCUREMENT] to run 1:00am the 1st of the month
- +10 ;
- +11 ;
- +12 ; The following new Variables were added to the CALC entry point:
- +13 ; YRRUN ; year option run
- +14 ; PYRRUN ; previous year option run
- +15 ; MTHRUN ; MONTHRUN
- +16 ; listed below are 3 examples:
- +17 ;
- +18 ; Month Option Run | Date Range for Run | # of months of data
- +19 ; Dec 1st, 2005 | Oct 1, 2005 to Dec 1st 2005| 2
- +20 ; Apr 1st, 2006 | Oct 1, 2005 to Apr 1st 2006| 6
- +21 ; Oct 1st, 2006 | Oct 1, 2005 to Oct 1st 2006| 12
- +22 ;
- STCLOBGN ; Set CLOBGN to Beginning of Fiscal Year (Oct. 1)
- +1 ;
- +2 IF MTHRUN=12!(MTHRUN=11)
- Begin DoDot:1
- +3 ; For Nov or Dec, CLOBGN set to Begin of FY(Oct 1st) in same year
- +4 SET CLOBGN=+(YRRUN_"10"_"00")
- +5 ; CLOEND is Date Extract Run
- SET CLOEND=%
- +6 QUIT
- End DoDot:1
- +7 ; (CLOBGN set to Prev FY for all other conditions)
- IF (MTHRUN<11)
- Begin DoDot:1
- +8 SET CLOBGN=+(PYRRUN_"10"_"00")
- +9 ; CLOEND is Date Extract Run
- SET CLOEND=%
- +10 QUIT
- End DoDot:1
- +11 ; (End new logic)
- +12 ;
- DEBUGFY ; Debug Fiscal Year logic by uncommenting code below 7/31/06 RLL
- +1 ;
- +2 DO GPARM
- +3 ; Make sure ^TMP($J) is set with data, otherwise return error
- +4 NEW CKTP
- +5 SET CKTP=$ORDER(^TMP($JOB,0))
- +6 IF CKTP=""
- Begin DoDot:1
- +7 ; error flag indicates no data in ^TMP($J)
- SET CLRSERR=1
- +8 QUIT
- End DoDot:1
- +9 QUIT
- +10 ;
- GPARM ; Get parameters for monthly extract
- +1 ;
- +2 ; need to set monthyear for data file
- +3 ;
- +4 NEW MNTHYR,FMDT1,MYRVAL
- +5 SET FMDT1=$PIECE(($$NOW^XLFDT),".",1)
- +6 SET MYRVAL=$$FMTE^XLFDT(FMDT1)
- +7 SET MNTHYR=$PIECE(MYRVAL," ",1)_","_$PIECE(MYRVAL," ",3)
- +8 ;
- +9 ; $O through the "AB" x-ref based on CLOBGN and CLOEND
- +10 ;
- +11 SET CLO1=CLOBGN
- SET CLO2=""
- SET CLO3=""
- +12 FOR
- SET CLO1=$ORDER(^PRC(442,"AB",CLO1))
- if CLO1=""
- QUIT
- Begin DoDot:1
- +13 FOR
- SET CLO2=$ORDER(^PRC(442,"AB",CLO1,CLO2))
- if CLO2=""
- QUIT
- Begin DoDot:2
- +14 if CLO1>(CLOEND-1)
- QUIT
- +15 DO GKEY
- +16 QUIT
- End DoDot:2
- +17 QUIT
- End DoDot:1
- +18 ; PRC*5.1*130 begin
- +19 DO GET410^PRCHLO6
- +20 DO GET424^PRCHLO6
- +21 ; PRC*5.1*130 end
- +22 ;Compile Invoice Tracking
- DO INVCOMPL^PRCHLO7
- +23 QUIT
- EXTR ; Extract the data, create files
- +1 ;
- GKEY ; get key for all tables
- +1 NEW POID,POCRDAT
- +2 SET POID=CLO2
- +3 ; PO Date from x-ref value
- SET POCRDAT=CLO1
- +4 ;
- DO GPOMAST^PRCHLO1
- +5 QUIT