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 Sep 23, 2025@19:44:30 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
