BARRASM2 ; IHS/SD/LSL - Age Summary Report by Fiscal Year ; 09/15/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**7,28**;OCT 26, 2005;Build 92
;New routine MRS:BAR*1.8*7 TO131 REQ_2
;IHS/SD/AML 1.8*28 CR8351 HEAT296731 Changed USM UAGE call to use 3P Approval Date, not Billed Date
;IHS/SD/SDR 1.8*28 CR8350 HEAT295594 Changed prompt for FY to prompt for a range of FYs and print as one report.
; Thanks to Jonathan Hubbard, Portland, for the code. Note, it is not the original code he provided. Had to
; modify some to allow for prompts not being answered, and to allow a single FY to still be selected.
;IHS/SD/AML 1.8*28 CR8351 HEAT296731 Made change so last day of fiscal year will be included by making end date 0930.999999
Q
; *********************************************************************
EN ; EP
K BARY,BAR
D:'$D(BARUSR) INIT^BARUTL ;Set up basic A/R Variables
N BARA
;S BARA=$$GETFY ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
D GETFY ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
;Q:BARA=0 ;Returns string ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
Q:Y="" ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
;S BARP("UAGE")=BARA ;Save FY range ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
;D EN^BARRASM ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
;start new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
S BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16) ; BILLING or VISIT
I BAR("LOC")="" S BAR("LOC")="VISIT"
D ASK^BARRASMA
W !!,"This report is designed to be session logged or sent to a ",! ;IHS/DIT/CPC - 20180502 CR8350
W "host file server device with no pauses between reports or full",! ;IHS/DIT/CPC - 20180502 CR8350
W "screens of information so please take appropriate steps to ",! ;IHS/DIT/CPC - 20180502 CR8350
W "allow viewing of the entire report.",! ;IHS/DIT/CPC - 20180502 CR8350
D EOP^BARUTL(0) ;-PAUSE IHS/DIT/CPC - 20180502 CR8350
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
M BARTBARY=BARY
M BARTBAR=BAR
D ^%ZIS
Q:POP
U IO
;S IOSL=999999 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 ;IHS/DIT/CPC - 20180502 CR8350
;
S BARI=0
F S BARI=$O(BARA(BARI)) Q:'BARI D
.Q:BARI=""
.S BARA=BARA(BARI)
.S BARP("UAGE")=BARA ;Save FY range
.D:'$D(BARUSR) INIT^BARUTL ;Set up basic A/R Variables
.S BARP("RTN")="BARRASM" ;Routine used to gather data
.S BAR("PRIVACY")=1 ;Privacy act applies (used BARRHD)
.S BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16) ; BILLING or VISIT
.I BAR("LOC")="" S BAR("LOC")="VISIT"
.;I '$D(BARA) D ASK^BARRASMA ;Ask all question but only if not USM report ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
.I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
.K BAR("LINE") ;IHS/DIT/CPC - 20180502 CR8350
.S $P(BAR("LINE"),"-",10)="" ;IHS/DIT/CPC - 20180502 CR8350
.W !!,BAR("LINE")_"Searching FY "_$P(BARP("UAGE"),U)_" "_BAR("LINE"),!! ;IHS/DIT/CPC - 20180502 CR8350
.D SETHDR^BARRASM ;Build header array
.D COMPUTE^BARRASM ;Build tmp global with data
.D PRINT^BARRASMB ;Print reports from tmp global
.M BARY=BARTBARY
.M BAR=BARTBAR
D ^%ZISC,HOME^%ZIS
;end new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
Q
; *********************************************************************
GETFY ;FIND FISCAL YEAR FOR REPORT ;removed function ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
;N BARA,BARFY,BARBEG,BAREND,BARZ ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
K BARA,BARFY,BARBEG,BAREND,BARZ ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
S BARA=$$FISCAL^XBDT() ;GET CURRENT FISCAL YEAR
S BARFY=$P(BARA,U)
D ^XBFMK ;KILL FM VARIABLES
;S DIR(0)="FOU^4:4^K:$$UPC^BARUTL(X)'?1""BULK""&($$UPC^BARUTL(X)'?1""FY""2N) X" ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
S DIR(0)="FOU^4:9^K:$$UPC^BARUTL(X)'?1""BULK""&($$UPC^BARUTL(X)'?1""FY""2N)&($$UPC^BARUTL(X)'?1""FY""2N1""-FY""2N) X" ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
;S DIR("S")="I $$UPC^BARUTL(X)?1""BULK""!($$UPC^BARUTL(X)?1""FY""2N)"
;S DIR("?",1)="BULK is limited to Billed Dates before 10/1/2008 and"
;S DIR("?",2)="corresponds to the BULK Invoices in UFMS"
;S DIR("?",3)="FY## allows you to enter a specific Fiscal Year"
;S DIR("?",4)="Type in FY followed by the two digit year"
S DIR("A")="Enter FISCAL YEAR for the Report"
;start old bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
;S DIR("A",1)="Enter BULK for Billed Date prior to 10/1/2008"
;S DIR("A",2)="Enter FYnn for specific Fiscal Year e.g. FY"_$E(BARFY,3,4)
;S DIR("A",3)=""
;S DIR("B")="BULK"
;end old start new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
S DIR("A",1)="BULK for Billed Date prior to 10/1/2008 will run automatically."
S DIR("A",2)="Enter FYnn-FYnn for a range of Fiscal Years e.g. FY09-FY12 "
S DIR("A",3)=""
S DIR("B")="FY08-FY"_$E(BARFY,3,4)
;end new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
W !!
D ^DIR
;I $D(DIRUT)!$D(DUOUT)!$D(DTOUT)!(Y="") Q 0 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
I $D(DIRUT)!$D(DUOUT)!$D(DTOUT)!(Y="") Q ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
I $L(Y)=4 S (BARSFY,BAREFY)=$E(Y,3,4) ;if only one FY selected ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
S:Y["-" BARSFY=$E(Y,3,4),BAREFY=$E(Y,8,9) ;range start and end FYs ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
;start old bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
;S BARZ=$$UPC^BARUTL(Y)
;I BARZ="BULK" D Q BARA
;.S BARA=BARZ_"^2571001^3081001" ;Everything prior to Go Live date
;S BARZ=$E(BARZ,3,4)
;I BARZ=$E(BARFY,3,4) Q BARA ;Current Fiscal Year
;S BARFY=$S(BARZ<40:(20_BARZ),1:(19_BARZ)) ;Change to 4 digits
;S BARA=BARFY_U_(BARFY-1700-1)_"1001"_U_(BARFY-1700)_"0930" ;Build DT-type string
;Q BARA
;end old start new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
F BARCFY=BARSFY:1:BAREFY D
.S BARZ=BARCFY
.S:$L(BARZ)=1 BARZ="0"_BARZ
.S BARFY=$S(BARZ<40:(20_BARZ),1:(19_BARZ)) ;Change to 4 digits
.S BARA(BARCFY)=BARFY_U_(BARFY-1700-1)_"1001"_U_(BARFY-1700)_"0930.999999" ;Build DT-type string ;bar*1.8*28 IHS/SD/AML CR8351 HEAT296731
.S:$P(BARA(BARCFY),U,1)=$P(BARA,U) BARA(BARCFY)=BARA
;end new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
;
UAGE(BAR) ;EP; EXTRINSIC FUNCTION
; Enters with BAR=DA of A/R Bill fille
; BARP("UAGE")=Fiscal year string
I 'BAR Q 0
N BARBEG,BAREND,BAR0
S BARBEG=$P(BARP("UAGE"),U,2)
S BAREND=$P(BARP("UAGE"),U,3)
;S BAR0=$P($G(^BARBL(DUZ(2),BAR,0)),U,7) ;BILLED DATE ;bar*1.8*28 IHS/SD/AML CR8351 HEAT296731
S BAR0=$P($G(^BARBL(DUZ(2),BAR,0)),U,18) ;3P APPROVE DATE ;bar*1.8*28 IHS/SD/AML CR8351 HEAT296731
I BAR0="" Q 0 ;No bill
I BAR0<BARBEG!(BAR0>BAREND) Q 0 ;Not within Fiscal Year range
Q 1
BARRASM2 ; IHS/SD/LSL - Age Summary Report by Fiscal Year ; 09/15/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**7,28**;OCT 26, 2005;Build 92
+2 ;New routine MRS:BAR*1.8*7 TO131 REQ_2
+3 ;IHS/SD/AML 1.8*28 CR8351 HEAT296731 Changed USM UAGE call to use 3P Approval Date, not Billed Date
+4 ;IHS/SD/SDR 1.8*28 CR8350 HEAT295594 Changed prompt for FY to prompt for a range of FYs and print as one report.
+5 ; Thanks to Jonathan Hubbard, Portland, for the code. Note, it is not the original code he provided. Had to
+6 ; modify some to allow for prompts not being answered, and to allow a single FY to still be selected.
+7 ;IHS/SD/AML 1.8*28 CR8351 HEAT296731 Made change so last day of fiscal year will be included by making end date 0930.999999
+8 QUIT
+9 ; *********************************************************************
EN ; EP
+1 KILL BARY,BAR
+2 ;Set up basic A/R Variables
IF '$DATA(BARUSR)
DO INIT^BARUTL
+3 NEW BARA
+4 ;S BARA=$$GETFY ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+5 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
DO GETFY
+6 ;Q:BARA=0 ;Returns string ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+7 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
IF Y=""
QUIT
+8 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+9 ;S BARP("UAGE")=BARA ;Save FY range ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+10 ;D EN^BARRASM ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+11 ;start new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+12 ; BILLING or VISIT
SET BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16)
+13 IF BAR("LOC")=""
SET BAR("LOC")="VISIT"
+14 DO ASK^BARRASMA
+15 ;IHS/DIT/CPC - 20180502 CR8350
WRITE !!,"This report is designed to be session logged or sent to a ",!
+16 ;IHS/DIT/CPC - 20180502 CR8350
WRITE "host file server device with no pauses between reports or full",!
+17 ;IHS/DIT/CPC - 20180502 CR8350
WRITE "screens of information so please take appropriate steps to ",!
+18 ;IHS/DIT/CPC - 20180502 CR8350
WRITE "allow viewing of the entire report.",!
+19 ;-PAUSE IHS/DIT/CPC - 20180502 CR8350
DO EOP^BARUTL(0)
+20 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+21 MERGE BARTBARY=BARY
+22 MERGE BARTBAR=BAR
+23 DO ^%ZIS
+24 IF POP
QUIT
+25 USE IO
+26 ;S IOSL=999999 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 ;IHS/DIT/CPC - 20180502 CR8350
+27 ;
+28 SET BARI=0
+29 FOR
SET BARI=$ORDER(BARA(BARI))
IF 'BARI
QUIT
Begin DoDot:1
+30 IF BARI=""
QUIT
+31 SET BARA=BARA(BARI)
+32 ;Save FY range
SET BARP("UAGE")=BARA
+33 ;Set up basic A/R Variables
IF '$DATA(BARUSR)
DO INIT^BARUTL
+34 ;Routine used to gather data
SET BARP("RTN")="BARRASM"
+35 ;Privacy act applies (used BARRHD)
SET BAR("PRIVACY")=1
+36 ; BILLING or VISIT
SET BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16)
+37 IF BAR("LOC")=""
SET BAR("LOC")="VISIT"
+38 ;I '$D(BARA) D ASK^BARRASMA ;Ask all question but only if not USM report ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+39 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+40 ;IHS/DIT/CPC - 20180502 CR8350
KILL BAR("LINE")
+41 ;IHS/DIT/CPC - 20180502 CR8350
SET $PIECE(BAR("LINE"),"-",10)=""
+42 ;IHS/DIT/CPC - 20180502 CR8350
WRITE !!,BAR("LINE")_"Searching FY "_$PIECE(BARP("UAGE"),U)_" "_BAR("LINE"),!!
+43 ;Build header array
DO SETHDR^BARRASM
+44 ;Build tmp global with data
DO COMPUTE^BARRASM
+45 ;Print reports from tmp global
DO PRINT^BARRASMB
+46 MERGE BARY=BARTBARY
+47 MERGE BAR=BARTBAR
End DoDot:1
+48 DO ^%ZISC
DO HOME^%ZIS
+49 ;end new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+50 QUIT
+51 ; *********************************************************************
GETFY ;FIND FISCAL YEAR FOR REPORT ;removed function ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+1 ;N BARA,BARFY,BARBEG,BAREND,BARZ ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+2 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
KILL BARA,BARFY,BARBEG,BAREND,BARZ
+3 ;GET CURRENT FISCAL YEAR
SET BARA=$$FISCAL^XBDT()
+4 SET BARFY=$PIECE(BARA,U)
+5 ;KILL FM VARIABLES
DO ^XBFMK
+6 ;S DIR(0)="FOU^4:4^K:$$UPC^BARUTL(X)'?1""BULK""&($$UPC^BARUTL(X)'?1""FY""2N) X" ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+7 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
SET DIR(0)="FOU^4:9^K:$$UPC^BARUTL(X)'?1""BULK""&($$UPC^BARUTL(X)'?1""FY""2N)&($$UPC^BARUTL(X)'?1""FY""2N1""-FY""2N) X"
+8 ;S DIR("S")="I $$UPC^BARUTL(X)?1""BULK""!($$UPC^BARUTL(X)?1""FY""2N)"
+9 ;S DIR("?",1)="BULK is limited to Billed Dates before 10/1/2008 and"
+10 ;S DIR("?",2)="corresponds to the BULK Invoices in UFMS"
+11 ;S DIR("?",3)="FY## allows you to enter a specific Fiscal Year"
+12 ;S DIR("?",4)="Type in FY followed by the two digit year"
+13 SET DIR("A")="Enter FISCAL YEAR for the Report"
+14 ;start old bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+15 ;S DIR("A",1)="Enter BULK for Billed Date prior to 10/1/2008"
+16 ;S DIR("A",2)="Enter FYnn for specific Fiscal Year e.g. FY"_$E(BARFY,3,4)
+17 ;S DIR("A",3)=""
+18 ;S DIR("B")="BULK"
+19 ;end old start new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+20 SET DIR("A",1)="BULK for Billed Date prior to 10/1/2008 will run automatically."
+21 SET DIR("A",2)="Enter FYnn-FYnn for a range of Fiscal Years e.g. FY09-FY12 "
+22 SET DIR("A",3)=""
+23 SET DIR("B")="FY08-FY"_$EXTRACT(BARFY,3,4)
+24 ;end new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+25 WRITE !!
+26 DO ^DIR
+27 ;I $D(DIRUT)!$D(DUOUT)!$D(DTOUT)!(Y="") Q 0 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+28 ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
IF $DATA(DIRUT)!$DATA(DUOUT)!$DATA(DTOUT)!(Y="")
QUIT
+29 ;if only one FY selected ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
IF $LENGTH(Y)=4
SET (BARSFY,BAREFY)=$EXTRACT(Y,3,4)
+30 ;range start and end FYs ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
IF Y["-"
SET BARSFY=$EXTRACT(Y,3,4)
SET BAREFY=$EXTRACT(Y,8,9)
+31 ;start old bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+32 ;S BARZ=$$UPC^BARUTL(Y)
+33 ;I BARZ="BULK" D Q BARA
+34 ;.S BARA=BARZ_"^2571001^3081001" ;Everything prior to Go Live date
+35 ;S BARZ=$E(BARZ,3,4)
+36 ;I BARZ=$E(BARFY,3,4) Q BARA ;Current Fiscal Year
+37 ;S BARFY=$S(BARZ<40:(20_BARZ),1:(19_BARZ)) ;Change to 4 digits
+38 ;S BARA=BARFY_U_(BARFY-1700-1)_"1001"_U_(BARFY-1700)_"0930" ;Build DT-type string
+39 ;Q BARA
+40 ;end old start new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+41 FOR BARCFY=BARSFY:1:BAREFY
Begin DoDot:1
+42 SET BARZ=BARCFY
+43 IF $LENGTH(BARZ)=1
SET BARZ="0"_BARZ
+44 ;Change to 4 digits
SET BARFY=$SELECT(BARZ<40:(20_BARZ),1:(19_BARZ))
+45 ;Build DT-type string ;bar*1.8*28 IHS/SD/AML CR8351 HEAT296731
SET BARA(BARCFY)=BARFY_U_(BARFY-1700-1)_"1001"_U_(BARFY-1700)_"0930.999999"
+46 IF $PIECE(BARA(BARCFY),U,1)=$PIECE(BARA,U)
SET BARA(BARCFY)=BARA
End DoDot:1
+47 ;end new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
+48 ;
UAGE(BAR) ;EP; EXTRINSIC FUNCTION
+1 ; Enters with BAR=DA of A/R Bill fille
+2 ; BARP("UAGE")=Fiscal year string
+3 IF 'BAR
QUIT 0
+4 NEW BARBEG,BAREND,BAR0
+5 SET BARBEG=$PIECE(BARP("UAGE"),U,2)
+6 SET BAREND=$PIECE(BARP("UAGE"),U,3)
+7 ;S BAR0=$P($G(^BARBL(DUZ(2),BAR,0)),U,7) ;BILLED DATE ;bar*1.8*28 IHS/SD/AML CR8351 HEAT296731
+8 ;3P APPROVE DATE ;bar*1.8*28 IHS/SD/AML CR8351 HEAT296731
SET BAR0=$PIECE($GET(^BARBL(DUZ(2),BAR,0)),U,18)
+9 ;No bill
IF BAR0=""
QUIT 0
+10 ;Not within Fiscal Year range
IF BAR0<BARBEG!(BAR0>BAREND)
QUIT 0
+11 QUIT 1
