Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARRASM2

BARRASM2.m

Go to the documentation of this file. 
  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
  1.  ;New routine MRS:BAR*1.8*7 TO131 REQ_2
  1.  ;IHS/SD/AML 1.8*28 CR8351 HEAT296731 Changed USM UAGE call to use 3P Approval Date, not Billed Date
  1.  ;IHS/SD/SDR 1.8*28 CR8350 HEAT295594 Changed prompt for FY to prompt for a range of FYs and print as one report.
  1.  ;   Thanks to Jonathan Hubbard, Portland, for the code.  Note, it is not the original code he provided.  Had to
  1.  ;   modify some to allow for prompts not being answered, and to allow a single FY to still be selected.
  1.  ;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
  1.  Q
  1.  ; *********************************************************************
  1. EN ; EP
  1.  K BARY,BAR
  1.  D:'$D(BARUSR) INIT^BARUTL   ;Set up basic A/R Variables
  1.  N BARA
  1.  ;S BARA=$$GETFY  ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  D GETFY  ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  ;Q:BARA=0                  ;Returns string  ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  Q:Y=""  ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q  ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  ;S BARP("UAGE")=BARA        ;Save FY range  ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  ;D EN^BARRASM  ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  ;start new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  S BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16)   ; BILLING or VISIT
  1.  I BAR("LOC")="" S BAR("LOC")="VISIT"
  1.  D ASK^BARRASMA
  1.  W !!,"This report is designed to be session logged or sent to a ",!     ;IHS/DIT/CPC - 20180502 CR8350
  1.  W "host file server device with no pauses between reports or full",!   ;IHS/DIT/CPC - 20180502 CR8350
  1.  W "screens of information so please take appropriate steps to ",!    ;IHS/DIT/CPC - 20180502 CR8350
  1.  W "allow viewing of the entire report.",!    ;IHS/DIT/CPC - 20180502 CR8350
  1.  D EOP^BARUTL(0) ;-PAUSE IHS/DIT/CPC - 20180502 CR8350
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q  ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  M BARTBARY=BARY
  1.  M BARTBAR=BAR
  1.  D ^%ZIS
  1.  Q:POP
  1.  U IO
  1.  ;S IOSL=999999  ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594 ;IHS/DIT/CPC - 20180502 CR8350
  1.  ;
  1.  S BARI=0
  1.  F  S BARI=$O(BARA(BARI)) Q:'BARI  D
  1.  .Q:BARI=""
  1.  .S BARA=BARA(BARI)
  1.  .S BARP("UAGE")=BARA          ;Save FY range
  1.  .D:'$D(BARUSR) INIT^BARUTL           ;Set up basic A/R Variables
  1.  .S BARP("RTN")="BARRASM"             ;Routine used to gather data
  1.  .S BAR("PRIVACY")=1                  ;Privacy act applies (used BARRHD)
  1.  .S BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16)   ; BILLING or VISIT
  1.  .I BAR("LOC")="" S BAR("LOC")="VISIT"
  1.  .;I '$D(BARA) D ASK^BARRASMA          ;Ask all question but only if not USM report  ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  .I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
  1.  .K BAR("LINE")   ;IHS/DIT/CPC - 20180502 CR8350
  1.  .S $P(BAR("LINE"),"-",10)=""  ;IHS/DIT/CPC - 20180502 CR8350
  1.  .W !!,BAR("LINE")_"Searching FY "_$P(BARP("UAGE"),U)_" "_BAR("LINE"),!!   ;IHS/DIT/CPC - 20180502 CR8350
  1.  .D SETHDR^BARRASM                    ;Build header array
  1.  .D COMPUTE^BARRASM      ;Build tmp global with data
  1.  .D PRINT^BARRASMB       ;Print reports from tmp global
  1.  .M BARY=BARTBARY
  1.  .M BAR=BARTBAR
  1.  D ^%ZISC,HOME^%ZIS
  1.  ;end new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  Q
  1.  ; *********************************************************************
  1. 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
  1.  K BARA,BARFY,BARBEG,BAREND,BARZ  ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  S BARA=$$FISCAL^XBDT()              ;GET CURRENT FISCAL YEAR
  1.  S BARFY=$P(BARA,U)
  1.  D ^XBFMK                            ;KILL FM VARIABLES
  1.  ;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
  1.  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
  1.  ;S DIR("S")="I $$UPC^BARUTL(X)?1""BULK""!($$UPC^BARUTL(X)?1""FY""2N)"
  1.  ;S DIR("?",1)="BULK is limited to Billed Dates before 10/1/2008 and"
  1.  ;S DIR("?",2)="corresponds to the BULK Invoices in UFMS"
  1.  ;S DIR("?",3)="FY## allows you to enter a specific Fiscal Year"
  1.  ;S DIR("?",4)="Type in FY followed by the two digit year"
  1.  S DIR("A")="Enter FISCAL YEAR for the Report"
  1.  ;start old bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  ;S DIR("A",1)="Enter BULK for Billed Date prior to 10/1/2008"
  1.  ;S DIR("A",2)="Enter FYnn for specific Fiscal Year e.g. FY"_$E(BARFY,3,4)
  1.  ;S DIR("A",3)=""
  1.  ;S DIR("B")="BULK"
  1.  ;end old start new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  S DIR("A",1)="BULK for Billed Date prior to 10/1/2008 will run automatically."
  1.  S DIR("A",2)="Enter FYnn-FYnn for a range of Fiscal Years e.g. FY09-FY12 "
  1.  S DIR("A",3)=""
  1.  S DIR("B")="FY08-FY"_$E(BARFY,3,4)
  1.  ;end new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  W !!
  1.  D ^DIR
  1.  ;I $D(DIRUT)!$D(DUOUT)!$D(DTOUT)!(Y="") Q 0  ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  I $D(DIRUT)!$D(DUOUT)!$D(DTOUT)!(Y="") Q  ;bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  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
  1.  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
  1.  ;start old bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  ;S BARZ=$$UPC^BARUTL(Y)
  1.  ;I BARZ="BULK" D  Q BARA
  1.  ;.S BARA=BARZ_"^2571001^3081001"           ;Everything prior to Go Live date
  1.  ;S BARZ=$E(BARZ,3,4)
  1.  ;I BARZ=$E(BARFY,3,4) Q BARA                ;Current Fiscal Year
  1.  ;S BARFY=$S(BARZ<40:(20_BARZ),1:(19_BARZ))  ;Change to 4 digits
  1.  ;S BARA=BARFY_U_(BARFY-1700-1)_"1001"_U_(BARFY-1700)_"0930"  ;Build DT-type string
  1.  ;Q BARA
  1.  ;end old start new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  F BARCFY=BARSFY:1:BAREFY  D
  1.  .S BARZ=BARCFY
  1.  .S:$L(BARZ)=1 BARZ="0"_BARZ
  1.  .S BARFY=$S(BARZ<40:(20_BARZ),1:(19_BARZ))  ;Change to 4 digits
  1.  .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
  1.  .S:$P(BARA(BARCFY),U,1)=$P(BARA,U) BARA(BARCFY)=BARA
  1.  ;end new bar*1.8*28 IHS/SD/SDR CR8350 HEAT295594
  1.  ;
  1. UAGE(BAR) ;EP; EXTRINSIC FUNCTION
  1.  ; Enters with BAR=DA of A/R Bill fille
  1.  ;             BARP("UAGE")=Fiscal year string
  1.  I 'BAR Q 0
  1.  N BARBEG,BAREND,BAR0
  1.  S BARBEG=$P(BARP("UAGE"),U,2)
  1.  S BAREND=$P(BARP("UAGE"),U,3)
  1.  ;S BAR0=$P($G(^BARBL(DUZ(2),BAR,0)),U,7)  ;BILLED DATE  ;bar*1.8*28 IHS/SD/AML CR8351 HEAT296731
  1.  S BAR0=$P($G(^BARBL(DUZ(2),BAR,0)),U,18)  ;3P APPROVE DATE  ;bar*1.8*28 IHS/SD/AML CR8351 HEAT296731
  1.  I BAR0="" Q 0                    ;No bill
  1.  I BAR0<BARBEG!(BAR0>BAREND) Q 0  ;Not within Fiscal Year range
  1.  Q 1