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

BARDMRQ.m

Go to the documentation of this file. 
  1. BARDMRQ ;IHS/OIT/FCJ - DEBT MANAGEMENT-QUE LETTER REPORT
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23,24**;OCT 26, 2005;Build 69
  1.  ;New routine 5-12-2011 for Debt Letter Management
  1.  ;
  1.  ;This report will provide letters ready to be printed by cycle, Insurer and detail
  1.  ;IHS/SD/POT SEP 2012 ADDED PAUSE AFTER MESSAGE- BAR*1.8*.23
  1.  ;IHS/SD/POT MAY 2013 CORRECTED SELD (1-0) & ALLOWED LOOP TO SELECT DETAILS - BAR*1.8*.24
  1.  ;IHS/SD/POT HEAT152452 2/10/2014 CHK IF PAR/SAT FILE CORECTLY SET UP  - BAR*1.8*.24
  1. ST ;
  1.  ;
  1.  D PAR^BARDMU
  1.  Q:$G(BARQ)  ;P.OTT HEAT152452 2/10/2014 - BAR*1.8*.24
  1.  N BARXYZ ;P.OTT
  1.  K ^TMP("BARDM",$J)  ;
  1.  S BMCQ=0,BARRPT="Q",BARSEQ=0
  1.  D SELC G:$D(DIRUT) XIT
  1.  D SELI G:$D(DIRUT) XIT
  1.  D:'$D(BARDCI) SELA G:$D(DIRUT) XIT
  1.  D CALC^BARDMRU
  1.  G:$G(BARQ) XIT
  1.  ;D PRINT
  1.  ;Q:(BMCQ=1)&(BARCY'="A")
  1.  ;I 'BARSEQ W !!,"**NO DATA TO PRINT **" H 3 G XIT ;P.OTT
  1.  ;S BARXYZ=BARSEQ ;KEEP MAX VALUE
  1.  ;F  S BARSEQ=BARXYZ D SELD Q:(BMCQ=1)
  1. TRT ;<--------------
  1.  S BARSEQ=0
  1.  D PRINT
  1.  Q:(BMCQ=1)&(BARCY'="A")
  1.  I 'BARSEQ W !!,"**NO DATA TO PRINT **" H 3 G XIT ;- BAR*1.8*.23
  1.  D SELD
  1.  I Y<1 G XIT
  1.  G TRT ;-----> ;BAR*1.8*.23
  1. XIT ;
  1.  K ^TMP("BARDM",$J)
  1.  K DIR
  1.  K BARL
  1.  Q
  1.  ;
  1. SELC ;SELECT CYCLE
  1.  S DIR(0)="S^1:CYCLE 1;2:CYCLE 2;3:CYCLE 3;4:CYCLE 4;A:ALL"
  1.  S DIR("A")="Select Cycle to View"
  1.  S DIR("B")="All",DIR("L")=""
  1.  S DIR("?")="Enter 1, 2, 3, 4 or A to view or all cycles"
  1.  S DIR("?",1)="   1 - CYCLE 1"
  1.  S DIR("?",2)="   2 - CYCLE 2"
  1.  S DIR("?",3)="   3 - CYCLE 3"
  1.  S DIR("?",4)="   4 - CYCLE 4"
  1.  D ^DIR
  1.  Q:$D(DIRUT)
  1.  S BARCY=Y,BARCYN=Y(0)
  1.  K DIR Q
  1.  ;
  1. SELI ;SELECT INSURANCE TYPE
  1.  S DIC="^BAR(90052.06,"_DUZ(2)_","_DUZ(2)_",19,"
  1.  S DIC(0)="AEQZ",DIC("A")="View by Insurer Type: "
  1.  D ^DIC
  1.  Q:$D(DUOUT)
  1.  S:$G(Y(0)) BARDCI=$$GET1^DIQ(90053.03,Y(0),".01","E")  ;
  1.  I $G(BARDCI)["NON-BEN" S BARDCI="PATIENT"  ;non-bens are listed under PATIENT in ^TMP("BARDM",$J) global  ;
  1.  K DIC,DA
  1.  Q
  1.  ;
  1. SELA ;SELECT ACCOUNT
  1.  S DIC="^BARAC("_DUZ(2)_","
  1.  S DIC(0)="AEQZ",DIC("A")="View by Account: "
  1.  S DIC("S")="I $P(^(0),U,7)=""Y"""
  1.  D ^DIC
  1.  Q:$D(DUOUT)
  1.  I $G(Y(0)) S BARDAC=$P(Y,U),BARDCA=$$VAL^XBDIQ1(90050.02,BARDAC,.01)
  1.  K DIC,DA
  1.  Q
  1. SELD ;SELECT DETAIL
  1.  S BMCQ=0
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Show Detail"
  1.  S DIR("B")="N"
  1.  W ! D ^DIR
  1.  I Y=0 S BMCQ=1 Q
  1.  K DIR
  1.  S DIR(0)="NO^1:"_BARSEQ
  1.  S DIR("A")="What sequence number"
  1.  D ^DIR
  1.  I Y<1 S BMCQ=1 Q
  1.  I Y>0 S BARSEQ=Y D
  1.  .D RRDT^BARDMU
  1.  .S BARDL=$P(^TMP("BARDM",$J,BARSEQ),U),BARDIT=$P(^(BARSEQ),U,2),BARDI=$P(^(BARSEQ),U,3)  ;
  1.  .D HDR2,DET
  1.  K DIR
  1.  Q
  1. PRINT ;
  1.  D HDR
  1.  I BARCY="A" F BARDL="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4" Q:$G(BARDLQ)  D TOT  ;
  1.  E  S BARDL=BARCYN D TOT  ;
  1.  Q
  1. HDR ;
  1.  W @IOF
  1.  W !,"SEQ",?6,"CYCLE",?13,"INS TYPE/INS-ACCOUNT",?55,"# OF BILLS",?69,"AMOUNT",!
  1.  F I=1:1:80 W "-"
  1.  Q
  1. HDR2 ;
  1.  S BARPG=BARPG+1  ;
  1.  W @IOF,!,BARRDT,?23,"LETTERS IN THE QUEUE READY TO PRINT",?70,"PAGE: ",BARPG  ;
  1.  W !!,"A/R PARENT LOCATION: ",BARPSAT(DUZ(2),.01)
  1.  W ?65,BARDL  ;
  1.  W !,"A/R ACCOUNT: ",BARDI,?62,"PERIOD: ",BARPCD($P(BARDL," ",2))," Days"  ;
  1.  W ! F I=1:1:80 W "="
  1.  W !,?40,"SERVICE",?49,"BILLED",?60,"BILLED"
  1.  W !,?2,"HRN",?8,"BILL #",?16,"PATIENT",?40,"DATE",?49,"DATE",?60,"AMOUNT",?72,"BALANCE"
  1.  W ! F I=1:1:80 W "-"
  1.  Q
  1. TOT ;PRINT TOTALS
  1.  I $P($G(^TMP("BARDM",$J,BARDL)),U)=0 W !!,BARDL," Does not contain any queued Letters" D  S BMCQ=1 Q  ; P.OTT PAUSE
  1.  . K DIR S (X,Y)=""
  1.  . S DIR(0)="E"
  1.  . S DIR("A")="Enter RETURN to Continue"
  1.  . D ^DIR
  1.  . K DIR
  1.  . QUIT
  1.  S BARDIT=0  F  S BARDIT=$O(^TMP("BARDM",$J,BARDL,BARDIT)) Q:BARDIT=""  D  Q:$G(BARDLQ)  ;
  1.  .S BARDI=0 F  S BARDI=$O(^TMP("BARDM",$J,BARDL,BARDIT,BARDI)) Q:BARDI=""  D  Q:$G(BARDLQ)  ;
  1.  ..I $D(BARDCA) Q:BARDI'=BARDCA
  1.  ..I $D(BARDCI) Q:BARDIT'=BARDCI
  1.  ..S BARSEQ=BARSEQ+1,BARDITI=BARDIT_"/"_BARDI
  1.  ..W !,BARSEQ,?5,BARDL,?13,$E(BARDITI,1,42),?55,$J($P(^TMP("BARDM",$J,BARDL,BARDIT,BARDI),U),7)  ;
  1.  ..S X=$P(^TMP("BARDM",$J,BARDL,BARDIT,BARDI),U,3) D COMMA^%DTC W ?66,$J(X,12)  ;
  1.  ..S ^TMP("BARDM",$J,BARSEQ)=BARDL_U_BARDIT_U_BARDI_U_$E(L,7)  ;
  1.  ..I $Y>(IOSL-6) W ! D RTRN^BARDMU Q:$G(BARDLQ)  D HDR
  1.  Q
  1. DET ;DETAIL
  1.  S BARDLQ=""
  1.  S BARBIL=0  F  S BARBIL=$O(^TMP("BARDM",$J,BARDL,BARDIT,BARDI,BARBIL)) Q:BARBIL=""  D  Q:$G(BARDLQ)
  1.  .S DFN=$P(^TMP("BARDM",$J,BARDL,BARDIT,BARDI,BARBIL),U),BARHRN=$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2),BARPAT=$P(^DPT(DFN,0),U)
  1.  .S BARDT=$P(^TMP("BARDM",$J,BARDL,BARDIT,BARDI,BARBIL),U,2)
  1.  .S BARSDT=$E(BARDT,4,5)_"/"_$E(BARDT,6,7)_"/"_$E(BARDT,2,3)
  1.  .S BARDT=$P(^TMP("BARDM",$J,BARDL,BARDIT,BARDI,BARBIL),U,3)
  1.  .S BARBDT=$E(BARDT,4,5)_"/"_$E(BARDT,6,7)_"/"_$E(BARDT,2,3)
  1.  .W !,BARHRN,?7,BARBIL,?16,$E(BARPAT,1,24),?40,BARSDT,?49,BARBDT
  1.  .S X=$P(^TMP("BARDM",$J,BARDL,BARDIT,BARDI,BARBIL),U,4) W ?58,$J(X,10,2) ;D COMMA^%DTC W 
  1.  .S X=$P(^TMP("BARDM",$J,BARDL,BARDIT,BARDI,BARBIL),U,5) W ?70,$J(X,10,2) ;D COMMA^%DTC W ?60,X
  1.  .I $Y>(IOSL-6) W ! D RTRN^BARDMU Q:$G(BARDLQ)  D HDR2
  1.  Q:$G(BARDLQ)
  1.  W !,?58,"----------",?70,"----------"
  1.  S TMP=^TMP("BARDM",$J,BARDL,BARDIT,BARDI)
  1.  W !,"TOTAL",?38,$P(TMP,U),"  Bill(s)"
  1.  S X=$P(TMP,U,2) W ?58,$J(X,10,2)
  1.  S X=$P(TMP,U,3) W ?70,$J(X,10,2)
  1.  W ! D RTRN^BARDMU Q:$G(BARDLQ)
  1.  Q