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

BARAST.m

Go to the documentation of this file. 
  1. BARAST ; IHS/SD/LSL - ACCOUNT STATEMENT ;
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
  1.  W !
  1.  I '$D(^BAR(90052.03,"B","ACCOUNT STATEMENT HEADER")) D ALTR
  1.  I '$D(^BARAC(DUZ(2),"AC")) D  Q
  1.  .W !!,"Accounts must be flagged first. Use the 'Flag Accounts option"
  1.  .W !,"to identifiy accounts to print statements for.",!
  1.  S ZTRTN="LOOP^BARAST"
  1.  ; -------------------------------
  1.  ;
  1. DEV ;
  1.  ; ask for printer device
  1.  S %ZIS="NQ"
  1.  S %ZIS("A")="Print Statements to Device: "
  1.  D ^%ZIS
  1.  Q:POP
  1.  I IO'=IO(0) D  Q
  1.  .S ZTDESC="PRINT A/R ACCOUNT STATEMENTS"
  1.  .K ZTSK
  1.  .D ^%ZTLOAD
  1.  .Q:'$G(ZTSK)
  1.  .W !,"Task # ",ZTSK," queued.",!
  1.  I $D(IO("S")) D
  1.  . S IOP=ION
  1.  . D ^%ZIS
  1.  Q:$G(BARFL1)
  1.  ; -------------------------------
  1.  ;
  1. LOOP ;EP
  1.  ; loop though ac x-ref
  1.  S BAREDT=$$FMADD^XLFDT(DT,-1)
  1.  S BARBDT=$$FMADD^XLFDT(DT,-31)
  1.  S BARLDT=0
  1.  F  S BARLDT=$O(^BARAC(DUZ(2),"AC",BARLDT)) Q:'BARLDT!(BARLDT>BARBDT)  D
  1.  .S BARAC=0
  1.  .F  S BARAC=$O(^BARAC(DUZ(2),"AC",BARLDT,BARAC)) Q:'BARAC  D
  1.  ..D ONE
  1.  ..D FDT
  1.  ; -------------------------------
  1.  ;
  1. KILL ;
  1.  ; clean up
  1.  K BARAC,BARLDT,BAREDT,BARC,BARFL1
  1.  D:$D(IO("S")) ^%ZISC
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. RPR ; EP
  1.  ; re-print one statement
  1.  W !
  1.  K DIC
  1.  S DIC="^BARAC(DUZ(2),"
  1.  S DIC(0)="AEMQ"
  1.  D ^DIC
  1.  Q:+Y<0
  1.  S DA(1)=+Y
  1.  S BARAC=+Y
  1.  S DIC="^BARAC(DUZ(2),DA(1),12,"
  1.  S DIC("S")="I '$P(^(0),""^"",2)"
  1.  D ^DIC
  1.  K DIC
  1.  Q:+Y<0
  1.  S DA=+Y
  1.  S ZTRTN="ONE^BARAST"
  1.  S BAREDT=$$FMADD^XLFDT(+Y,-1)
  1.  S BARFL1=1
  1.  N I
  1.  F I="BAREDT","BARLDT","BARFL1","BARAC" S ZTSAVE(I)=""
  1.  K ZTSK
  1.  D DEV
  1.  Q:$G(ZTSK)
  1.  D ONE
  1.  D KILL
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. ONE ;
  1.  ; ONE ACCOUNT
  1.  K BARC
  1.  K DIQ
  1.  S DIC="^BARAC(DUZ(2),"
  1.  S DA=BARAC
  1.  S DIQ="BARC("
  1.  S DR=".01;1.01:1.06;301"
  1.  D EN^DIQ1
  1.  S BARLDT=$O(^BARAC(DUZ(2),BARAC,12,"B",BAREDT),-1)
  1.  S BARSBAL=$$BAL^BARUTL(BARAC,BARLDT-1)
  1.  S BAREBAL=BARSBAL
  1.  S BARPG=0
  1.  D HDR
  1.  S BARTOT=0,DA=0
  1.  F  S DA=$O(^BARTR(DUZ(2),"AE",BARAC,DA)) Q:'DA  D
  1.  .I $Y+6>IOSL D
  1.  ..W !,?18,"CONT'D"
  1.  ..D HDR
  1.  .S BARTDT=$P(^BARTR(DUZ(2),DA,0),"^",1)
  1.  .S BARDAY=$P(BARTDT,".",1)
  1.  .Q:BARDAY<BARLDT
  1.  .Q:BARDAY>BAREDT
  1.  .D TPRT
  1.  S BAREBAL=BARSBAL+BARTOT
  1.  D FTR
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. FDT ;file date in statement sub-file
  1.  S DA(1)=BARAC
  1.  S X=DT
  1.  S DIC="^BARAC(DUZ(2),DA(1),12,"
  1.  S DIC(0)="LX"
  1.  D ^DIC
  1.  Q:+Y<0
  1.  S DA=+Y
  1.  K ^BARAC(DUZ(2),"AC",BARLDT,BARAC)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. TPRT ;LIST ONE TRANSACTION
  1.  K DIQ
  1.  S DIC="^BARTR(DUZ(2),"
  1.  S DIQ="BART("
  1.  S DR=".01;3.5;4;101"
  1.  D EN^DIQ1
  1.  S BART(90050.03,DA,3.5)=BART(90050.03,DA,3.5)*-1
  1.  S BARTOT=BARTOT+BART(90050.03,DA,3.5)
  1.  W !,$P(BART(90050.03,DA,.01),"@",1)
  1.  W ?15,$P(BART(90050.03,DA,4),"-",1,2)
  1.  W ?27,$E(BART(90050.03,DA,101),1,30)
  1.  W:BART(90050.03,DA,101)["PAYMENT" " - THANK YOU"
  1.  W ?65,$J($FN(BART(90050.03,DA,3.5),"P,",2),12)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. HDR ;STATEMENT HEADER
  1.  S:'$D(BARDASH) $P(BARDASH,"-",80)=""
  1.  N DA
  1.  W $$EN^BARVDF("IOF")
  1.  S BARPG=BARPG+1
  1.  W !!,$$FMTE^XLFDT(DT),?20,"S T A T E M E N T   O F   A C C O U N T",?70,"Page: ",BARPG
  1.  S DA=$O(^BAR(90052.03,"B","ACCOUNT STATEMENT HEADER",0))
  1.  I DA W ! F I=1:1:10 D
  1.  .W:$D(^BAR(90052.03,DA,1,I,0)) !,^(0)
  1.  W !!,"FOR ACCOUNT: ",BARC(90050.02,BARAC,.01)
  1.  N I
  1.  F I=1.01,1.02,1.03,1.04,1.05,1.06 D
  1.  .Q:BARC(90050.02,BARAC,I)=""
  1.  .I I<1.05 W !,?13
  1.  .I I=1.05 W ", "
  1.  .I I=1.06 W "  "
  1.  .W BARC(90050.02,BARAC,I)
  1.  W !!,"Statement Covers Period From: ",$$CDT^BARDUTL(BARLDT)," To: ",$$CDT^BARDUTL(BAREDT)
  1.  W !!,?40,"BEGINNING BALANCE: ",?65,$J($FN(BARSBAL,",P",2),12)
  1.  W !!,BARDASH
  1.  W !,?26,"T R A N S A C T I O N S "
  1.  W !,"Trans Date",?15,"Bill#",?27,"Description",?70,"Amount",!
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. FTR ;
  1.  ; STATEMENT FOOTER
  1.  W !!,?18,"TOTAL:"
  1.  W ?65,$J($FN(BARTOT,",P",2),12)
  1.  W !,BARDASH
  1.  W !!,?46,"BALANCE DUE: ",?65,$J($FN(BAREBAL,",P",2),12)
  1.  W !!
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. ALTR ;EP - add the statement header text
  1.  S DIC="^BAR(90052.03,"
  1.  S DIC(0)="LX"
  1.  S X="ACCOUNT STATEMENT HEADER"
  1.  D ^DIC
  1.  Q:+Y<0
  1.  S DA=+Y
  1.  W $$EN^BARVDF("IOF")
  1.  W !!,"You may enter text that will appear at the top of the account"
  1.  W !,"statements. Typically this will be facility name and address,"
  1.  W !,"business office phone number, point of contact, and special"
  1.  W !,"messages. The statements will print up to 10 lines of text.",!
  1.  S DIE="^BAR(90052.03,"
  1.  S DR=100
  1.  D ^DIE
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. FLAG ;EP - flag accounts for statements
  1.  K DIR
  1.  S DIR("A")="Flag an individual account or loop? "
  1.  S DIR("B")=1
  1.  S DIR(0)="S^1:INDIVIDUAL;2:LOOP"
  1.  D ^DIR
  1.  K DIR
  1.  S BARANS=Y
  1.  I BARANS=1 F  D  Q:+$G(Y)<0
  1.  .K DIC
  1.  .S DIC="^BARAC(DUZ(2),"
  1.  .S DIC(0)="AEMQ"
  1.  .D ^DIC
  1.  .Q:+Y<0
  1.  .S BARAC=+Y
  1.  .S BARBDT=$$FMADD^XLFDT(DT,-31)
  1.  .S BARCNT=0
  1.  .D OFL
  1.  .W !!,"Account",$S(BARCNT=0:" already ",1:" "),"flagged.",!
  1.  I BARANS=2 D
  1.  .S DIC="^BARTBL("
  1.  .S DIC(0)="AEMQ"
  1.  .S DIC("S")="I $P(^(0),""^"",3)=""ACTY"""
  1.  .S DIC("A")="Select Type of Account: "
  1.  .S DIC("B")="PATIENT"
  1.  .D ^DIC
  1.  .K DIC
  1.  .Q:+Y<0
  1.  .S BARTYP=$P(Y,"^",2)
  1.  .S BARBDT=$$FMADD^XLFDT(DT,-31)
  1.  .S BARCNT=0,BARAC=0
  1.  .F  S BARAC=$O(^BARAC(DUZ(2),"ATYP",BARTYP,BARAC)) Q:'BARAC  D OFL
  1.  .W !!,BARCNT," accounts flagged."
  1.  .F  W ! Q:$Y+4>IOSL
  1.  .D EOP^BARUTL(0)
  1.  K BARBDT,BARANS,BARAC,BARTYP,BARCNT
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. OFL ;set one
  1.  Q:$O(^BARAC(DUZ(2),BARAC,12,0))
  1.  S ^BARAC(DUZ(2),BARAC,12,0)="^90050.0212D^^"
  1.  S DA(1)=BARAC
  1.  S DIC="^BARAC(DUZ(2),DA(1),12,"
  1.  S DIC(0)="LX",X=BARBDT
  1.  D ^DIC
  1.  Q:+Y<0
  1.  S DA=+Y
  1.  S DIE=DIC
  1.  S DR=".02///1"
  1.  D ^DIE
  1.  S BARCNT=BARCNT+1
  1.  Q