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

BARDRST1.m

Go to the documentation of this file. 
  1. BARDRST1 ; IHS/SD/LSL - Statistical Report - Part 3 ; 07/30/2010
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**10,15,19,20**;OCT 26, 2005
  1.  ;
  1.  ; TMM 11/13/09   1.8*15 Resolve HEAT 8548.  Error in BARDRST1.
  1.  ; TMM 07/30/2010 1.8*19 Modify A/R Statistical Report to print
  1.  ;                            in a printer or delimited file format.
  1.  ;                            Allow user to select (Employer) Group Plans
  1.  ;                            when selecting  by BILLING ENTITY/6)SELECT
  1.  ;                            A SPECIFIC A/R ACCOUNT. See requirement
  1.  ;                            4PMS10022.
  1.  ; ********************************************************************
  1. PRINT ;EP for writing data
  1.  S BAR("PG")=0
  1.  ;K BAR(1)  bar*1.8*20 HEAT27283
  1.  ;start new code bar*1.8*20 HEAT27283
  1.  I $D(BAR(1))<11 K BAR(1)
  1.  I $D(BAR(1))>10 D
  1.  .S BAR("L")=0
  1.  .K BARTMP
  1.  .F  S BAR("L")=$O(BAR(1,BAR("L"))) Q:'BAR("L")  M BARTMP(1,BAR("L"))=BAR(1,BAR("L"))
  1.  .M BAR(1,"COVD")=BAR(1,"COVD")
  1.  .K BAR(1)
  1.  .M BAR(1)=BARTMP(1)
  1.  .K BARTMP
  1.  ;end new code HEAT27283
  1.  K BAR(0)
  1.  D HDB
  1.  S BAR("L")=0
  1.  S BAR("NLU")=0                ;MRS:BAR*1.8*10 H2260
  1.  F BAR("NL")=1:1 S BAR("L")=$O(BAR(BAR("L"))) Q:'BAR("L")  D  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  .I $Y>(IOSL-7) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  .W !!,$P(^DIC(4,BAR("L"),0),U)
  1.  .S (BAR("N"),BAR("B"),BAR("P"),BAR("A"),BAR("C"))=0
  1.  .S UNDUP=0                       ;M1*TMM*11/13/2009 HEAT_8548
  1.  .S BAR("V")=""
  1.  .F  S BAR("V")=$O(BAR(BAR("L"),BAR("V"))) Q:'BAR("V")  D  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  ..I $Y>(IOSL-6) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)  W !,$P(^DIC(4,BAR("L"),0),U)," (cont)"
  1.  ..; ---BEGIN DEL(1)--->  ;M819*ADD*TMM*20100801-->replaced with ADD(1) section that follows
  1.  ..; Replace current WRITE's with WRITE/DELIMITER dependent on BARTEXT value
  1.  ..; ;Nest line prints visit type  ;M819*DEL*TMM*20100801
  1.  ..; ..W !?2    ;M819*DEL*TMM*20100731
  1.  ..; ..I BARY("SORT")="V" D   ;M819*DEL*TMM*20100801
  1.  ..; ...I BAR("V")=99999 W "NO VISIT TYP" Q    ;M819*DEL*TMM*20100801
  1.  ..; ...I $P($G(^ABMDVTYP(BAR("V"),0)),U)]"" W $E($P(^ABMDVTYP(BAR("V"),0),U),1,12) Q  ;M819*DEL*TMM*20100801
  1.  ..; ...W "DELETED ",BAR("V")   ;M819*DEL*TMM*20100801
  1.  ..; ..E  D   ;M819*DEL*TMM*20100801
  1.  ..; ...I BAR("V")=99999 W "NO CLINIC" Q   ;M819*DEL*TMM*20100801
  1.  ..; ...W $E($P(^DIC(40.7,BAR("V"),0),U),1,12)                 ;clinic stop name  ;M819*DEL*TMM*20100801
  1.  ..; ..W ?16,$J($FN($P(BAR(BAR("L"),BAR("V")),U),",",0),5)     ;number of visits   ;M819*DEL*TMM*20100801
  1.  ..; ..W ?22,$J($FN($P(BAR(BAR("L"),BAR("V")),U,2),",",0),5)   ;total undup patients   ;M819*DEL*TMM*20100801
  1.  ..; ..S UNDUP=UNDUP+$P(BAR(BAR("L"),BAR("V")),U,2)    ;M1*TMM*11/13/2009 HEAT_8548   ;M819*DEL*TMM*20100801
  1.  ..; ..;Next line writes $ with comma and cents   ;M819*DEL*TMM*20100801
  1.  ..; ..W ?27,$J($FN($P(BAR(BAR("L"),BAR("V")),U,3),",",2),13)  ;total billed amount   ;M819*DEL*TMM*20100801
  1.  ..; ..W ?41,$J($FN($P(BAR(BAR("L"),BAR("V")),U,4),",",2),12)  ;total paid amount   ;M819*DEL*TMM*20100801
  1.  ..; ..W ?55,$J($FN($P(BAR(BAR("L"),BAR("V")),U,5),",",2),12)  ;total adjustment amount   ;M819*DEL*TMM*20100801
  1.  ..; ..W ?66,$J($FN($P(BAR(BAR("L"),BAR("V")),U,6),",",2),13)  ;total unpaid amount   ;M819*DEL*TMM*20100801
  1.  ..; -----END DEL(1)--->  ;M819*ADD*TMM*20100801-->replaced with ADD(1) section that follows
  1.  ..; ---BEGIN ADD(1)--->  ;M819*ADD*TMM*20100801-->replaces DEL(1) section preceding this section
  1.  ..; Next line prints visit type
  1.  ..I $G(BARTEXT)'=1 W !?2
  1.  ..I $G(BARTEXT)=1 W !,"^"
  1.  ..I BARY("SORT")="V" D
  1.  ...I BAR("V")=99999 W "NO VISIT TYP"_$$TEXTCK^BARDRST() Q     ;(B)
  1.  ...I $P($G(^ABMDVTYP(BAR("V"),0)),U)]"" W $E($P(^ABMDVTYP(BAR("V"),0),U),1,12)_$$TEXTCK^BARDRST() Q   ;(B)
  1.  ...W "DELETED ",BAR("V")_$$TEXTCK^BARDRST()                        ;(B)
  1.  ..E  D
  1.  ...I BAR("V")=99999 W "NO CLINIC"_$$TEXTCK^BARDRST() Q                       ;(B)
  1.  ...W $E($P(^DIC(40.7,BAR("V"),0),U),1,12)_$$TEXTCK^BARDRST()    ;clinic stop name (B)
  1.  ..I $E(BARTEXT)'=1 D
  1.  ...W ?16,$J($FN($P(BAR(BAR("L"),BAR("V")),U),",",0),5)     ;number of visits
  1.  ...W ?22,$J($FN($P(BAR(BAR("L"),BAR("V")),U,2),",",0),5)   ;total undup patients
  1.  ..I $E(BARTEXT)=1 D
  1.  ...W $J($FN($P(BAR(BAR("L"),BAR("V")),U),",",0),5)_"^"     ;number of visits (C)
  1.  ...W $J($FN($P(BAR(BAR("L"),BAR("V")),U,2),",",0),5)_"^"   ;total undup patients (D)
  1.  ..S UNDUP=UNDUP+$P(BAR(BAR("L"),BAR("V")),U,2)    ;M1*TMM*11/13/2009 HEAT_8548
  1.  ..; Next line writes $ with comma and cents
  1.  ..I $E(BARTEXT)'=1 D
  1.  ...W ?27,$J($FN($P(BAR(BAR("L"),BAR("V")),U,3),",",2),13)  ;total billed amount
  1.  ...W ?41,$J($FN($P(BAR(BAR("L"),BAR("V")),U,4),",",2),12)  ;total paid amount
  1.  ...W ?55,$J($FN($P(BAR(BAR("L"),BAR("V")),U,5),",",2),12)  ;total adjustment amount
  1.  ...W ?66,$J($FN($P(BAR(BAR("L"),BAR("V")),U,6),",",2),13)  ;total unpaid amount
  1.  ..I $E(BARTEXT)=1 D
  1.  ...W $J($FN($P(BAR(BAR("L"),BAR("V")),U,3),",",2),13)_"^"  ;total billed amount (E)
  1.  ...W $J($FN($P(BAR(BAR("L"),BAR("V")),U,4),",",2),12)_"^"  ;total paid amount (F)
  1.  ...W $J($FN($P(BAR(BAR("L"),BAR("V")),U,5),",",2),12)_"^"  ;total adjustment amount (G)
  1.  ...W $J($FN($P(BAR(BAR("L"),BAR("V")),U,6),",",2),13)_"^"  ;total unpaid amount (H)
  1.  ..; -----END ADD(1)--->  ;M819*ADD*TMM*20100801-->replaces DEL section preceding this section
  1.  ..S BAR("N")=$P(BAR(BAR("L"),BAR("V")),U,1)+BAR("N")
  1.  ..S BAR("NLN")=BAR("NLN")+$P(BAR(BAR("L"),BAR("V")),U,1)
  1.  ..S BAR("B")=$P(BAR(BAR("L"),BAR("V")),U,3)+BAR("B")
  1.  ..S BAR("NLB")=BAR("NLB")+$P(BAR(BAR("L"),BAR("V")),U,3)
  1.  ..S BAR("P")=$P(BAR(BAR("L"),BAR("V")),U,4)+BAR("P")
  1.  ..S BAR("NLP")=BAR("NLP")+$P(BAR(BAR("L"),BAR("V")),U,4)
  1.  ..S BAR("A")=$P(BAR(BAR("L"),BAR("V")),U,5)+BAR("A")
  1.  ..S BAR("NLA")=BAR("NLA")+$P(BAR(BAR("L"),BAR("V")),U,5)
  1.  ..S BAR("C")=$P(BAR(BAR("L"),BAR("V")),U,6)+BAR("C")
  1.  ..;S BAR("NLC")=BAR("NLC")+$P(BAR(BAR("L"),BAR("V")),U,6)  ;MRS:BAR*1.8*10 H2260
  1.  ..S BAR("NLU")=BAR("NLU")+$P(BAR(BAR("L"),BAR("V")),U,6)   ;MRS:BAR*1.8*10 H2260
  1.  .;---BEGIN DEL(2)--->  ;M819*ADD*TMM*20100801-->replaced with ADD(2) section that follows
  1.  .; .W !,?15,"------",?22,"------",?30,"----------",?43,"----------",?57,"----------",?70,"----------"
  1.  .; .W !?16,$J($FN(BAR("N"),",",0),5)
  1.  .; .;W ?22,$J($FN(BAR("LC",BAR("L")),",",0),5)         ;M1*TMM*11/13/2009 HEAT_8548
  1.  .; .W ?22,$J($FN(UNDUP,",",0),5)                       ;M1*TMM*11/13/2009 HEAT_8548
  1.  .; .W ?28,$J($FN(BAR("B"),",",2),12)
  1.  .; .W ?40,$J($FN(BAR("P"),",",2),13)
  1.  .; .W ?55,$J($FN(BAR("A"),",",2),12)
  1.  .; .W ?67,$J($FN(BAR("C"),",",2),13)
  1.  .; .;PRINT INPATIENT DAYS - WILL PRINT 0 DAYS ALSO         
  1.  .; .W !!
  1.  .; .W "TOTAL COVERED INPATIENT DAYS  ",+$GET(BAR(BAR("L"),"COVD"))
  1.  .; .W !
  1.  .; W !,?10,"END OF REPORT",!
  1.  .; -----END DEL(2)--->  ;M819*ADD*TMM*20100801-->replaced with ADD(2) section that follows
  1.  .; ---BEGIN ADD(2)--->  ;M819*ADD*TMM*20100801-->replaces DEL(2) section preceding this section
  1.  .; Printer format
  1.  .I $G(BARTEXT)'=1 D
  1.  ..W !,?15,"------",?22,"------",?30,"----------",?43,"----------",?57,"----------",?70,"----------"
  1.  ..W !?16,$J($FN(BAR("N"),",",0),5)
  1.  ..;W ?22,$J($FN(BAR("LC",BAR("L")),",",0),5)         ;M1*TMM*11/13/2009 HEAT_8548
  1.  ..W ?22,$J($FN(UNDUP,",",0),5)                       ;M1*TMM*11/13/2009 HEAT_8548
  1.  ..W ?28,$J($FN(BAR("B"),",",2),12)
  1.  ..W ?40,$J($FN(BAR("P"),",",2),13)
  1.  ..W ?55,$J($FN(BAR("A"),",",2),12)
  1.  ..W ?67,$J($FN(BAR("C"),",",2),13)
  1.  .; Delimited file format
  1.  .I $G(BARTEXT)=1 D
  1.  ..W !,"^^------^------^----------^----------^----------^----------"
  1.  ..W !,"^^",$J($FN(BAR("N"),",",0),5)             ;(C)
  1.  ..;W "^^",$J($FN(BAR("LC",BAR("L")),",",0),5)         ;M1*TMM*11/13/2009 HEAT_8548
  1.  ..W "^",$J($FN(UNDUP,",",0),5)                   ;(D)  M1*TMM*11/13/2009 HEAT_8548
  1.  ..W "^",$J($FN(BAR("B"),",",2),12)               ;(E)
  1.  ..W "^",$J($FN(BAR("P"),",",2),13)               ;(F)
  1.  ..W "^",$J($FN(BAR("A"),",",2),12)               ;(G)
  1.  ..W "^",$J($FN(BAR("C"),",",2),13)               ;(H)
  1.  ..;PRINT INPATIENT DAYS - WILL PRINT 0 DAYS ALSO         
  1.  .W !!
  1.  .I $G(BARTEXT)'=1 W "TOTAL COVERED INPATIENT DAYS ",+$GET(BAR(BAR("L"),"COVD"))
  1.  .I $G(BARTEXT)=1 W "^TOTAL COVERED INPATIENT DAYS^",+$GET(BAR(BAR("L"),"COVD"))
  1.  .W !
  1.  .W !,"END OF REPORT",!
  1.  .; -----END ADD(2)--->  ;M819*ADD*TMM*20100801-->replaces DEL(2) section preceding this section
  1.  ;
  1.  I $E(IOST)="C",'$D(IO("S")) D
  1.  .K DIR
  1.  .S DIR(0)="E"
  1.  .D ^DIR
  1.  .K DIR
  1.  I BAR("NL")<3 G XIT
  1.  ; ---BEGIN DEL(3)--->  ;M819*DEL*TMM*20100801 replaced with ADD(3) section that follows
  1.  W !,?17,"======",?25,"======",?29,"==========",?42,"==========",?67,"=========="
  1.  ;TOOK OUT TOTAL UNDUP CNT 2/98 SL
  1.  W !?10,"Total:",?20,$J($FN(BAR("NLN"),",",0),5)
  1.  W ?29,$J($FN(BAR("NLB"),",",2),13)
  1.  W ?41,$J($FN(BAR("NLP"),",",2),13)
  1.  W ?55,$J($FN(BAR("NLA"),",",2),12)
  1.  ;W ?67,$J($FN(BAR("NLC"),",",2),13) ;MRS:BAR*1.8*10 H2260
  1.  W ?67,$J($FN(BAR("NLU"),",",2),13)  ;MRS:BAR*1.8*10 H2260
  1.  ; -----END DEL(3)--->  ;M819*DEL*TMM*20100801 replaced with ADD(3) section that follows
  1.  ; ---BEGIN DEL(3)--->  ;M819*DEL*TMM*20100801 replaced with ADD(3) section that follows
  1.  ; Printer format
  1.  I $G(BARTEXT)'=1 D
  1.  . W !,?17,"======",?25,"======",?29,"==========",?42,"==========",?67,"=========="
  1.  . ;TOOK OUT TOTAL UNDUP CNT 2/98 SL
  1.  . W !?10,"Total:",?20,$J($FN(BAR("NLN"),",",0),5)
  1.  . W ?29,$J($FN(BAR("NLB"),",",2),13)
  1.  . W ?41,$J($FN(BAR("NLP"),",",2),13)
  1.  . W ?55,$J($FN(BAR("NLA"),",",2),12)
  1.  . ;W ?67,$J($FN(BAR("NLC"),",",2),13) ;MRS:BAR*1.8*10 H2260
  1.  . W ?67,$J($FN(BAR("NLU"),",",2),13)  ;MRS:BAR*1.8*10 H2260
  1.  ; Delimited file format
  1.  I $G(BARTEXT)=1 D
  1.  . W !,"^======^======^==========^==========^=========="
  1.  . ;TOOK OUT TOTAL UNDUP CNT 2/98 SL
  1.  . W !,"^^Total:^",$J($FN(BAR("NLN"),",",0),5)
  1.  . W "^",$J($FN(BAR("NLB"),",",2),13)
  1.  . W "^",$J($FN(BAR("NLP"),",",2),13)
  1.  . W "^",$J($FN(BAR("NLA"),",",2),12)
  1.  . ;W ?67,$J($FN(BAR("NLC"),",",2),13) ;MRS:BAR*1.8*10 H2260
  1.  . W "^",$J($FN(BAR("NLU"),",",2),13)  ;MRS:BAR*1.8*10 H2260
  1.  ; -----END DEL(3)--->  ;M819*DEL*TMM*20100801 replaced with ADD(3) section that follows
  1.  G XIT
  1.  ; *********************************************************************
  1. HD ;
  1.  D PAZ^BARRUTL
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  ;
  1. HDB ;
  1.  S BAR("PG")=BAR("PG")+1
  1.  S BAR("I")=""
  1.  D WHD^BARRHD
  1.  ; ---BEGIN DEL(1)--->  ;M819*ADD*TMM*20100731--> replaced by ADD(1) section that follows
  1.  ;W !!?2,$S(BARY("SORT")="V":"VISIT",1:"")                                               ;M819*DEL*TMM*20100731
  1.  ;W ?15,"NUMBER",?22,"UNDUP",?35,"BILLED",?48,"PAID",?60,"ADJ",?74,"UNPAID"              ;M819*DEL*TMM*20100731
  1.  ;W !?2,$S(BARY("SORT")="V":"TYPE",1:"CLINIC")                                           ;M819*DEL*TMM*20100731
  1.  ;W ?15,"VISITS",?22,"PATIENTS",?35,"AMOUNT",?48,"AMOUNT",?60,"AMOUNT",?74,"AMOUNT"      ;M819*DEL*TMM*20100731
  1.  ;W !,"-------------------------------------------------------------------------------"  ;M819*DEL*TMM*20100731
  1.  ; -----END DEL(1)--->  ;M819*ADD*TMM*20100731--> replaced by ADD(1) section that follows
  1.  ; ---BEGIN ADD(1)--->  ;M819*ADD*TMM*20100731--> replaces DEL(1) section that preceds this
  1.  I $G(BARTEXT)'=1 D
  1.  .W !!?2,$S(BARY("SORT")="V":"VISIT",1:"")    ;M819*DEL*TMM*20100731
  1.  .W ?15,"NUMBER",?22,"UNDUP",?35,"BILLED",?48,"PAID",?60,"ADJ",?74,"UNPAID"
  1.  .W !?2,$S(BARY("SORT")="V":"TYPE",1:"CLINIC")    ;M819*DEL*TMM*20100731
  1.  .W ?15,"VISITS",?22,"PATIENTS",?35,"AMOUNT",?48,"AMOUNT",?60,"AMOUNT",?74,"AMOUNT"
  1.  .S $P(BARTMPLN,"-",80)=""
  1.  .W !,BARTMPLN
  1.  I $G(BARTEXT)=1 D
  1.  .W !!,U,$S(BARY("SORT")="V":"VISIT",1:"")
  1.  .W U,"NUMBER",U,"UNDUP",U,"BILLED",U,"PAID",U,"ADJ",U,"UNPAID"
  1.  .W !,U,$S(BARY("SORT")="V":"TYPE",1:"CLINIC")
  1.  .W U,"VISITS",U,"PATIENTS",U,"AMOUNT",U,"AMOUNT",U,"AMOUNT",U,"AMOUNT"
  1.  .S $P(BARTMPLN,"-",80)=""
  1.  .W !,"^",BARTMPLN
  1.  ; -----END ADD(1)--->  ;M819*ADD*TMM*20100731--> replaces DEL(1) section that preceds thisQ
  1.  ; *********************************************************************
  1. XIT ;
  1.  K ^TMP($J,"BAR-ST")
  1.  Q