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

IBJDF71.m

Go to the documentation of this file. 
  1. IBJDF71 ;ALB/MR - REPAYMENT PLAN REPORT (COMPILE);15-AUG-00
  1.  ;;2.0;INTEGRATED BILLING;**123**;21-MAR-94
  1.  ;
  1. ST ; - Tasked entry point.
  1.  K IB,^TMP("IBJDF7",$J),^TMP("IBJDF7PAT",$J) S IBQ=0
  1.  ;
  1.  ; - Initialize the array IB
  1.  F I=1:1:12 S IB(I)=0
  1.  ;
  1.  ; - Find the data required for report. Loops through all the Active
  1.  ;   Bills (Status 16) and checks if bill has a Repayment Plan
  1.  ; 
  1.  S IBDA=""
  1.  F  S IBDA=$O(^PRCA(430,"AC",16,IBDA)) Q:'IBDA  D  Q:IBQ
  1.  . I IBDA#100=0 S IBQ=$$STOP^IBOUTL("Repayment Plan Report") Q:IBQ
  1.  . S IBAR=$G(^PRCA(430,IBDA,0)) Q:'IBAR
  1.  . I '$P($G(^PRCA(430,IBDA,4)),"^") Q  ; No Repayment Plan
  1.  . S IBCAT=+$P(IBAR,"^",2)  ;            Gets valid AR category.
  1.  . I '$$MCCR(IBCAT) Q  ;                 Checks MCCR vs. NON-MCCR
  1.  . S DEB=$P(IBAR,"^",9)  ;               Gets the pointer to the Debtor
  1.  . S IBPAT=$$PAT(DEB) Q:IBPAT=""  ;      Gets patient info.
  1.  . S DFN=$P(IBPAT,"^",5)  ;              Gets the pointer to the Patient
  1.  . ;
  1.  . ; - Retrieves Repayment Plan Data
  1.  . S IBRP=$$REPDATA^RCBECHGA(IBDA,IBDAYS)
  1.  . S IBCHK=0 I IBRP="" S IBCHK=$$DBLCHK(IBDA) I 'IBCHK Q
  1.  . ;
  1.  . ; - Set the temporary global
  1.  . I IBPLN="B"!(IBPLN="C"&'$P(IBRP,"^",8))!(IBPLN="D"&$P(IBRP,"^",8)) D 
  1.  . . S KEY=$P(IBPAT,"^")
  1.  . . S IBPT=$G(^TMP("IBJDF7",$J,KEY,DFN))
  1.  . . I IBPT="" S IBPT=$P(IBPAT,"^",2,4)
  1.  . . I $P(IBRP,"^",8),'$P(IBPT,"^",4) S $P(IBPT,"^",4)=1
  1.  . . S ^TMP("IBJDF7",$J,KEY,DFN)=IBPT
  1.  . . S ^TMP("IBJDF7",$J,KEY,DFN,$P(IBAR,"^"))=IBRP_"^"_$$BAL(IBDA)
  1.  . ;
  1.  . ; - Updates the IB array for the Summary Report
  1.  . I 'IBCHK D SUM(IBRP,DFN)
  1.  ;
  1.  I 'IBQ D EN^IBJDF72 ; Print the report.
  1.  ;
  1. ENQ K ^TMP("IBJDF7",$J),^TMP("IBJDF7PAT",$J)
  1.  I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
  1.  ;
  1.  D ^%ZISC
  1. ENQ1 K DFN,I,IB,IBCHK,IBDA,IBAR,IBCAT,IBCD,IBPAT,IBPT,IBQ,IBRP,KEY
  1.  Q
  1.  ;
  1. MCCR(X) ; - Checks if the Bill category is the type selected by the users 
  1.  ;   (MCCR or NON-MCCR)
  1.  ;   Input: X=AR category pointer to file #430.2
  1.  ;   Output: Y= 1 - Matches user selection / 0 - Doesn't match
  1.  ; 
  1.  I (X>11&(X<18))!(X=19)!(X=20)!(X>26&(X<32)) Q:IBMCR="N" 1 Q 0
  1.  I IBMCR="M" Q 1
  1.  Q 0
  1.  ;
  1. PAT(DEB) ; - Find the AR patient and decide to include the AR.
  1.  ; Input: DEB=Debtor file pointer (file #340)
  1.  ; Output: Y=Sort key (name or SSN) ^ Name ^ SSN ^ Date of death (if any)
  1.  ;           ^Pointer to Patient file
  1.  ;
  1.  N DEATH,DFN,KEY,NAME,SSN,VA,VADM,VAERR,Y,RCDZ
  1.  S Y="" I 'DEB G PATQ
  1.  S RCDZ=$G(^RCD(340,DEB,0)) I $P(RCDZ,"^")'["DPT" G PATQ
  1.  S DFN=+RCDZ
  1.  D DEM^VADPT S NAME=VADM(1),SSN=$P(VADM(2),"^",2),DEATH=$P(VADM(6),".")
  1.  S KEY=$S(IBSN="N":NAME,1:$P(SSN,"-",3))
  1.  S Y="" I KEY=""!(IBSNF'="@"&('DFN)) G PATQ
  1.  I $D(IBSNA) G:IBSNA="ALL"&('DFN) PATQ G:IBSNA="NULL"&(DFN) PATQ
  1.  I IBSNF="@",IBSNL="zzzzz" G PATC
  1.  I IBSNF]KEY!(KEY]IBSNL) G PATQ
  1.  ;
  1. PATC S Y=KEY_"^"_NAME_"^"_SSN_"^"_DEATH_"^"_DFN
  1. PATQ Q Y
  1.  ;
  1. BAL(BILL) ; Calculates the Account Balance for the Bill
  1.  ; Input: BILL - Bill internal # - Pointer to file #430
  1.  ; Output: BAL - Bill Balance
  1.  ;
  1.  N B7,BAL,I
  1.  ;
  1.  S B7=$G(^PRCA(430,BILL,7))
  1.  S BAL=0 F I=1:1:5 S BAL=BAL+$P(B7,"^",I)
  1.  ;
  1.  Q BAL
  1.  ;
  1. DBLCHK(BILL) ; Double-checks if the receivable does not have any Repayment
  1.  ;         Plan information at all
  1.  ; Output: 0 - No Repayment Plan Info or Repayment Plan paid in full
  1.  ;         1 - Some Repayment Plan Info
  1.  ;
  1.  N ARZ,DBLCHK,I,IBPMT
  1.  ;
  1.  S DBLCHK=0
  1.  ; - Repayment Plan has been paid in full
  1.  S IBPMT=$O(^PRCA(430,BILL,5,999),-1)
  1.  I IBPMT,$P($G(^PRCA(430,BILL,5,IBPMT)),"^",2) Q DBLCHK
  1.  ;
  1.  ; - Looks for some information on file about the Repayment Plan
  1.  S ARZ=$G(^PRCA(430,BILL,4))
  1.  F I=1:1:4 I $P(ARZ,"^",I)'="" S DBLCHK=1 Q
  1.  ;
  1.  Q DBLCHK
  1.  ;
  1. SUM(IBRP,DFN) ; Sets the array IB with the Summary information
  1.  ; Input: IBRP=Array returned by the function $$RP (See estructure above)
  1.  ;        DFN=Pointer to the Patient file
  1.  ; Output: Updates the IB array with summary iformation
  1.  ;
  1.  N X S X=$S($P(IBRP,"^",8):"D",1:"C")
  1.  ;
  1.  ; - Updates summary information for Defaulted Plans
  1.  I X="D" D
  1.  . S IB(1)=IB(1)+1
  1.  . I '$D(^TMP("IBJDF7PAT",$J,DFN,X)) S IB(2)=IB(2)+1
  1.  ;
  1.  ; - Updates summary information for Current Plans
  1.  I X="C" D
  1.  . S IB(5)=IB(5)+1
  1.  . I '$D(^TMP("IBJDF7PAT",$J,DFN,X)) S IB(6)=IB(6)+1
  1.  ;
  1.  ; - Defaulted  Outstanding balance and # of Payments
  1.  S IB(3)=IB(3)+($P(IBRP,"^",3)*$P(IBRP,"^",8))
  1.  S IB(4)=IB(4)+$P(IBRP,"^",8)
  1.  ;
  1.  ; - Current Outstanding balance and # of Payments
  1.  S IB(7)=IB(7)+($P(IBRP,"^",3)*($P(IBRP,"^",7)-$P(IBRP,"^",8)))
  1.  S IB(8)=IB(8)+($P(IBRP,"^",7)-$P(IBRP,"^",8))
  1.  ;
  1.  ; - Total Number of Patients (Unique)
  1.  I '$D(^TMP("IBJDF7PAT",$J,DFN)) S IB(10)=IB(10)+1
  1.  ;
  1.  ; - Used to prevent counting the same patient twice
  1.  S ^TMP("IBJDF7PAT",$J,DFN,X)=""
  1.  Q