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

IB20P202.m

Go to the documentation of this file. 
  1. IB20P202 ;WOIFO/AAT-GMT IB PART 3 POST-INSTALL ;24-OCT-02
  1.  ;;2.0;INTEGRATED BILLING;**202**;21-MAR-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. POST ;Post-Install procedure
  1.  ;
  1.  K ^TMP($J,"IB20P202")
  1.  D PRNMSG ; Print message to the user
  1.  D RELALL ; Force conversion for all remaining patients
  1.  ; Remove temporary global nodes
  1.  K ^XTMP("IB GMT CONVERSION")
  1.  K ^IB("AGMT")
  1.  K ^IB("AGMTP")
  1.  K ^TMP($J,"IB20P202")
  1.  Q
  1.  ;
  1.  ; Add the patient to the log message
  1. ADDPAT(DFN,IBRES,IBNUM) N IBPT,IBSTA
  1.  S IBPT=$P($G(^DPT(DFN,0)),U) ;Patient's name
  1.  S IBSTA=$P($$LST^DGMTU(DFN),"^",3) ;Patient's Copayment Status
  1.  S IBSTA=$E(IBSTA,1,20),IBSTA=IBSTA_$J("",20-$L(IBSTA))
  1.  D ADDLN($J(IBNUM,3)_" "_IBPT_$J("",30-$L(IBPT))_" "_IBSTA_" "_(+IBRES)_" Charge"_$S(IBRES=1:"",1:"s"))
  1.  Q
  1.  ;
  1.  ;Add a line to the text array
  1. ADDLN(IBTXT) N IBC
  1.  D MES^XPDUTL("  "_$G(IBTXT))
  1.  S IBC=$O(^TMP($J,"IB20P202",""),-1)+1
  1.  S ^TMP($J,"IB20P202",IBC)=$G(IBTXT," ")
  1.  Q
  1.  ;
  1. RELALL ;Release all remaining held charges off hold;
  1.  N DFN,IBRES,IBNUM,XMSUB,XMY,XMDUZ,XMTEXT,XMGROUP,DIFROM
  1.  D ADDLN("Geographic Means Test Clean-up, patch IB*2.0*202 post-install procedure.")
  1.  D ADDLN("During the GMT IB Clean-up procedure all Inpatient Means Test charges, placed")
  1.  D ADDLN("ON HOLD (RATE) since October 1, 2002, will be released and passed to the")
  1.  D ADDLN("Accounts Receivable package.")
  1.  D ADDLN("For patients with 'GMT COPAY REQUIRED' status charges will be recalculated.")
  1.  D ADDLN("Process started on "_$$NOW())
  1.  D ADDLN()
  1.  D ADDLN("Searching and processing patients, who did not pass the GMT conversion...")
  1.  D ADDLN()
  1.  S IBNUM=0
  1.  S DFN=0 F  S DFN=$O(^IB("AGMTP",DFN)) Q:'DFN  D
  1.  . S IBRES=$$RELHOLD(DFN)
  1.  . S IBNUM=IBNUM+1
  1.  . D ADDPAT(DFN,IBRES,IBNUM)
  1.  I IBNUM=0 D ADDLN("none found.")
  1.  I $D(^IB("AC",20)) D FORCEREL ; Force releasing of hold charges on hold (rate)
  1.  D ADDLN()
  1.  D ADDLN("Process finished at "_$$NOW())
  1.  D ADDLN()
  1.  I $D(^IB("AC",20)) D
  1.  . D ADDLN("Some charges still remain on hold (rate), they may be not related to GMT.")
  1.  . D ADDLN("Use 'List Charges Awaiting New Copay Rate' menu option to make sure, that ")
  1.  . D ADDLN("there is no GMT-related charges, placed on hold, because of unknown rate.")
  1.  I IBNUM>0 D ADDLN(),ADDLN("Use the 'Means Test Single Patient Billing Profile' report to review charges.")
  1.  ;
  1.  ; Send log message to IB MEANS TEST mail group.
  1.  S XMSUB="GEOGRAPHIC MEANS TEST CLEAN-UP PROCEDURE"
  1.  S XMDUZ="PATCH IB*2.0*202 POST-INIT"
  1.  S XMGROUP=$$GET1^DIQ(350.9,"1,",.11) ; Means Test billing Group
  1.  S XMY(DUZ)="" ; Send the message to the user (at least)
  1.  I XMGROUP'="" S XMY("G."_XMGROUP)=""
  1.  S XMTEXT="^TMP($J,""IB20P202"","
  1.  ;
  1.  D ^XMD
  1.  Q
  1.  ;
  1. FORCEREL ; Force releasing remaining charges on hold (rate)
  1.  N IBACT,IBCNT
  1.  S IBCNT=0
  1.  S IBACT=0 F  S IBACT=$O(^IB("AC",20,IBACT)) Q:'IBACT  I $$RELCRG(IBACT) S IBCNT=IBCNT+1
  1.  I IBCNT D ADDLN(IBCNT_" inpatient charges were released off hold additionally.")
  1.  Q
  1.  ;
  1.  ;Perform "conversion" for the given patient 
  1. RELHOLD(DFN) N IBACT,IBDT,X,IBLIMIT,IBCNT
  1.  S DFN=+DFN
  1.  S IBLIMIT=$$PLUS($$GMTEFD^IBAGMT(),-30)
  1.  S IBCNT=0
  1.  ;For each Patient's IB Action starting from the last, back to the GMT Effective Date:
  1.  S IBDT="" F  S IBDT=$O(^IB("APTDT",DFN,IBDT),-1) Q:IBDT=""  Q:IBDT<IBLIMIT  D
  1.  . S IBACT="" F  S IBACT=$O(^IB("APTDT",DFN,IBDT,IBACT),-1) Q:'IBACT  S IBCNT=IBCNT+$$RELCRG(IBACT)
  1.  K ^IB("AGMTP",DFN) ; Remove the flag
  1.  Q IBCNT
  1.  ;
  1.  ;
  1.  ; Release/recalculate the single charge
  1.  ; Also adjust MT Billing Clock Data, if this is a Copay charge.
  1.  ; Input: IB ACTION IEN
  1.  ; Output: 1 - Processed, 0 - Charge does not need to be processed (or error)
  1. RELCRG(IBACT) N DFN,IBZ,IBSTA,IBDT,IBCRG,IBNOS,IBSEQNO,IBDUZ,IBFDA,IBGMT,Y,IBCLK,IB90D,IBCLKZ,IBAMT,IBATYP
  1.  S IBZ=$G(^IB(IBACT,0)) Q:IBZ="" 0 ;Corrupted cross-reference
  1.  S DFN=$P(IBZ,U,2)
  1.  S IBSTA=$P(IBZ,U,5) I IBSTA'=20,IBSTA'=1 Q 0 ;Not a 'HOLD-RATE' and not an 'INCOMPLETE'
  1.  S IBATYP=+$P(IBZ,U,3) ; IB Action Type
  1.  S IBDT=$P(IBZ,U,14) ; Date Billed From
  1.  I IBDT<$$GMTEFD^IBAGMT() Q 0 ;Never touch charges 'billed from' before the GMT Effective Date
  1.  I '$$ISGMTTYP^IBAGMT(IBATYP) Q 0 ;Not a MT Inpatient charge
  1.  S X="RCERR^IB20P202",@^%ZOSF("TRAP")
  1.  S IBCRG=$P(IBZ,U,7) ;Charge Amount
  1.  S IBGMT=$$ISGMTPT^IBAGMT(DFN,IBDT) ; GMT Status for the patient
  1.  ;Recalculate the charge
  1.  I IBGMT>0,'$P(^IB(IBACT,0),U,21) D  ;If the patient has GMT Copayment Status
  1.  . S $P(^IB(IBACT,0),U,7)=$$REDUCE^IBAGMT(IBCRG) ;Reduce the amount to 20%
  1.  . S $P(^IB(IBACT,0),U,21)=1 ;Mark the charge as GMT RELATED
  1.  . Q:'$G(^IB("AGMT",IBACT))  ; Quit if that is not COPAY charge.
  1.  . ; The temporary node "AGMT" exists only for Inpatient Copay Charges.
  1.  . ; Adjusting MT Billing Clock Amount
  1.  . S IBCLK=+$P(^IB("AGMT",IBACT),U),IB90D=+$P(^(IBACT),U,2) Q:IB90D<1  Q:IB90D>4
  1.  . S IBCLKZ=$G(^IBE(351,IBCLK,0)) Q:IBCLKZ=""
  1.  . S IBAMT=+$P(IBCLKZ,"^",4+IB90D) S IBAMT=IBAMT-IBCRG+$$REDUCE^IBAGMT(IBCRG) S:IBAMT<0 IBAMT=0
  1.  . S $P(^IBE(351,IBCLK,0),U,4+IB90D)=IBAMT
  1.  K ^IB("AGMT",IBACT) ; Remove temporary node
  1.  ; Now pass the held charge to the AR package (Incomplete charges will not be released)
  1.  I IBSTA'=1 S IBNOS=IBACT,IBSEQNO=$P($G(^IBE(350.1,IBATYP,0)),U,5) S:IBSEQNO="" IBSEQNO=1 S IBDUZ=DUZ D ^IBR I Y<0 D ERRMSG(IBACT,$P(Y,U,2,99))
  1.  I IBGMT'>0,IBSTA=1 Q 0  ; Incomplete charges for non-GMT patients
  1.  Q 1
  1.  ;
  1. RCERR N IBERR  ;Error trapping for RELCRG
  1.  S IBERR=$$EC^%ZOSV
  1.  D ^%ZTER
  1.  D ERRMSG(IBACT,"Program Error "_IBERR)
  1.  Q 0
  1.  ;
  1. PLUS(IBDT,IBDAYS) N X,X1,X2,%H
  1.  S X1=IBDT,X2=IBDAYS
  1.  D C^%DTC
  1.  Q X
  1.  ;
  1.  ; Send error message to IB MEANS TEST group.
  1.  ; "Please review the IB ACTION"
  1. ERRMSG(IBACT,IBERR) N IBTXT,XMSUB,XMY,XMDUZ,XMTEXT,XMGROUP,DIFROM,IBGRP,IBI,DFN,IBPT,IBZ,IBC,IBDT,IBATYP
  1.  S XMSUB="IB GMT CLEAN-UP ERROR"
  1.  S XMDUZ="PATCH IB*2.0*202 POST-INIT"
  1.  S XMGROUP=$$GET1^DIQ(350.9,"1,",.11) ; Means Test billing Group
  1.  I XMGROUP="" S XMGROUP=DUZ ; No billing groups defined - send to the user
  1.  E  S XMGROUP="G."_XMGROUP
  1.  S XMTEXT="IBTXT(",XMY(XMGROUP)=""
  1.  ;
  1.  S IBZ=$G(^IB(IBACT,0))
  1.  S DFN=$P(IBZ,U,2),IBPT=$P($G(^DPT(DFN,0)),U)
  1.  S IBDT=$P(IBZ,U,14),IBATYP=+$P(IBZ,U,3)
  1.  S IBC=0
  1.  S IBC=IBC+1,IBTXT(IBC)="The Geographic Means Test software failed to process the Inpatient Means Test"
  1.  S IBC=IBC+1,IBTXT(IBC)="charge IEN "_IBACT_", placed on HOLD - RATE (or Incomplete) after the GMT Effective Date."
  1.  S IBC=IBC+1,IBTXT(IBC)=" "
  1.  S IBC=IBC+1,IBTXT(IBC)="The error occurred when trying to pass the charge to Accounts Receivable."
  1.  S IBC=IBC+1,IBTXT(IBC)="Please review the IB ACTION IEN "_IBACT_"."
  1.  S IBC=IBC+1,IBTXT(IBC)=" "
  1.  I $G(IBERR)'="" D
  1.  . S IBC=IBC+1,IBTXT(IBC)="Error code: "_IBERR
  1.  . S IBC=IBC+1,IBTXT(IBC)=" "
  1.  S IBC=IBC+1,IBTXT(IBC)="DIAGNOSTIC INFORMATION:"
  1.  S IBC=IBC+1,IBTXT(IBC)="Patient: "_IBPT
  1.  S IBC=IBC+1,IBTXT(IBC)="IB Action IEN: "_IBACT_", Date billed from: "_$$DAT($P(IBZ,"^",14))_", Date billed to: "_$$DAT($P(IBZ,"^",15))
  1.  S IBC=IBC+1,IBTXT(IBC)="IB Action Type: "_$E($$ACTNM^IBOUTL(IBATYP),1,30)
  1.  S IBC=IBC+1,IBTXT(IBC)="Total Charge Amount: "_$J($P(IBZ,U,7),"",2)_", The charge is "_$S($P(IBZ,U,21):"",1:"not ")_"marked as GMT Related."
  1.  I '$P(IBZ,U,21),IBDT'<$$GMTEFD^IBAGMT(),$$ISGMTTYP^IBAGMT(IBATYP),$$ISGMTPT^IBAGMT(DFN,IBDT)>0 D
  1.  . S IBC=IBC+1,IBTXT(IBC)="The amount must be decreased to 20% of initial value (GMT rate)."
  1.  . I '$P(IBZ,U,21) S IBC=IBC+1,IBTXT(IBC)="The charge is supposed to be GMT Related."
  1.  ;
  1.  D ^XMD
  1.  Q
  1.  ;
  1.  ;
  1. DAT(IBDT) ; Convert FM date to (mm/dd/yy) format.
  1.  I 'IBDT Q ""
  1.  Q $$FMTE^XLFDT(IBDT,"2MZ")
  1.  ;
  1. NOW() N %,%H,%I,X,Y
  1.  D NOW^%DTC S Y=%
  1.  D DD^%DT
  1.  S Y=$P(Y,"@")_" at "_$P(Y,"@",2)
  1.  Q Y
  1.  ;
  1. PRNMSG ;
  1.  N IBTXT
  1.  S IBTXT(1)=""
  1.  S IBTXT(2)="  Geographic Means Test, IB Part 3, Post-Install Starting"
  1.  S IBTXT(3)=""
  1.  S IBTXT(4)="  The procedure will find, adjust and bill all remaining"
  1.  S IBTXT(5)="  GMT-related IB charges, placed on hold since 10/1/2002,"
  1.  S IBTXT(6)="  because of unknown rate."
  1.  S IBTXT(7)=""
  1.  S IBTXT(8)="  The process will take some time ..."
  1.  S IBTXT(9)=""
  1.  D MES^XPDUTL(.IBTXT)
  1.  Q