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

IBAMTC3.m

Go to the documentation of this file.
  1. IBAMTC3 ;ALB/CJM - BULLETINS FOR UNCLOSED EVENTS,UNPASSED CHARGES ; 21-APRIL-92
  1. ;;2.0;INTEGRATED BILLING;**153,703**;21-MAR-94;Build 5
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. BULLET1 N IBT,IBC,XMSUB,XMY,XMDUZ,XMTEXT
  1. S IBC=1,IBDUZ=$G(DUZ)
  1. D HDR1,PAT1,CHRG1,MAIL^IBAERR1
  1. Q
  1. BULLET2 N IBT,IBC,XMSUB,XMY,XMDUZ,XMTEXT
  1. S IBC=1,IBDUZ=$G(DUZ)
  1. D HDR2,PAT2,CHRG2,MAIL^IBAERR1
  1. Q
  1. MAIL ; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CALL MAIL^IBAERR1
  1. ; F I=1:1:(IBC-1) W IBT(I),!
  1. ; Q
  1. HDR1 ;
  1. S XMSUB="REQUIRED VERIFICATION OF MEANS TEST CHARGES"
  1. S IBT(IBC)="Please verify the Means Test charges for the following inpatient admission:",IBC=IBC+1
  1. Q
  1. HDR2 ;
  1. S XMSUB="MEANS TEST CHARGES NOT YET PASSED TO ACCOUNTS RECEIVABLE"
  1. S IBT(IBC)="The following charge is "_IBOLD_" days old and has not been passed to Accounts ",IBT(IBC+1)="Receivable. Action is required to edit, cancel, or pass the charge.",IBC=IBC+2
  1. Q
  1. CHRG2 ;
  1. N I,IBTYPE,IBFROM,IBTO,IBAMOUNT
  1. D CHGDATA
  1. S IBT(IBC)="Type : "_IBTYPE,IBC=IBC+1
  1. S IBT(IBC)="From : "_IBFROM,IBC=IBC+1
  1. S IBT(IBC)="To : "_IBTO,IBC=IBC+1
  1. S IBT(IBC)="Amount : "_IBAMOUNT,IBC=IBC+1
  1. Q
  1. CHRG1 ;
  1. N I,IBTYPE,IBFROM,IBTO,IBAMOUNT
  1. I 'IBPASS&(IBCHG) D
  1. .S IBT(IBC)=" ",IBT(IBC+1)="These charges have not been passed to Accounts Receivable.",IBT(IBC+2)="Action is required to edit, cancel, or pass the charges.",IBT(IBC+3)=" ",IBC=IBC+4
  1. .S IBT(IBC)=$$PR("Type",30)_$$PR("From",16)_$$PR("To",16)_$$PR("Amount",15),IBC=IBC+1
  1. .F I=1:1:IBCHG S IBND=$G(^IB(IBCHG(I),0)) D CHGDATA D
  1. ..S IBT(IBC)=$$PR(IBTYPE,30)_$$PR(IBFROM,16)_$$PR(IBTO,16)_$$PR(IBAMOUNT,15),IBC=IBC+1
  1. Q
  1. CHGDATA ;
  1. S Y=$P(IBND,"^",14) D:Y DD^%DT S IBFROM=Y
  1. S Y=$P(IBND,"^",15) D:Y DD^%DT S IBTO=Y
  1. S IBTYPE=$P(IBND,"^",3) S:IBTYPE IBTYPE=$P($G(^IBE(350.1,IBTYPE,0)),"^",1)
  1. S IBAMOUNT="$"_+$P(IBND,"^",7)
  1. Q
  1. PAT1 ; patient demographic data, admission and discharge date
  1. N VAERR,VADM,DFN,IBNAME,IBID,IBADMIT,VA
  1. S IBT(IBC)=" ",IBC=IBC+1
  1. S DFN=+$P(IBND,"^",2) D DEM^VADPT I VAERR K VADM
  1. S IBNAME=$G(VADM(1)),IBID=$G(VA("PID"))
  1. S Y=$P(IBND,"^",17) D DD^%DT S IBADMIT=Y
  1. S Y=IBDISC D DD^%DT S IBDISC=Y
  1. S IBT(IBC)="Patient Name: "_IBNAME,IBC=IBC+1
  1. S IBT(IBC)="Patient Id : "_IBID,IBC=IBC+1
  1. S IBT(IBC)="Admitted : "_IBADMIT,IBC=IBC+1
  1. S IBT(IBC)="Discharged : "_IBDISC,IBC=IBC+1
  1. Q
  1. PAT2 ; patient demographic data, admission and discharge date
  1. N VAERR,VADM,DFN,IBNAME,IBID,IBADMIT,IBPARENT,IBDISC,VA
  1. S IBT(IBC)=" ",IBC=IBC+1,(IBADMIT,IBDISC)=""
  1. S DFN=+$P(IBND,"^",2) D DEM^VADPT I VAERR K VADM
  1. S IBNAME=$G(VADM(1)),IBID=$G(VA("PID"))
  1. S IBPARENT=$P(IBND,"^",16) I $G(IBPARENT) D
  1. .N IBND S IBND=$G(^IB(IBPARENT,0))
  1. .S Y=$P(IBND,"^",17) D DD^%DT S IBADMIT=Y
  1. .D DISC^IBAMTC2 I IBDISC S Y=IBDISC D DD^%DT S IBDISC=Y
  1. S IBT(IBC)="Patient Name: "_IBNAME,IBC=IBC+1
  1. S IBT(IBC)="Patient Id : "_IBID,IBC=IBC+1
  1. S IBT(IBC)="Admitted : "_IBADMIT,IBC=IBC+1
  1. S IBT(IBC)="Discharged : "_IBDISC,IBC=IBC+1
  1. Q
  1. PR(STR,LEN) ; pad right
  1. N B S STR=$E(STR,1,LEN),$P(B," ",LEN-$L(STR))=" "
  1. Q STR_$G(B)
  1. ;
  1. CANCBLTN ; send Mailman bulletin for cancelled copays (covid relief) IB*2.0*703
  1. ;
  1. ; ^TMP("IBAMTC3",$J) is set and killed in the calling routine (CANCEL^IBAMTC)
  1. ;
  1. N CNT,DIFROM,IBREF,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,Z
  1. I '$D(^TMP("IBAMTC3",$J)) Q ; nothing to report
  1. S CNT=0
  1. ; successful cancellations
  1. I $D(^TMP("IBAMTC3",$J,1)) D
  1. .S CNT=CNT+1,^TMP("IBAMTC3",$J,"MSG",CNT)="Copays successfully cancelled by IB Means Test nightly job:"
  1. .S CNT=CNT+1,^TMP("IBAMTC3",$J,"MSG",CNT)=""
  1. .S CNT=CNT+1,^TMP("IBAMTC3",$J,"MSG",CNT)="IB Reference No. Bill Number"
  1. .S CNT=CNT+1,^TMP("IBAMTC3",$J,"MSG",CNT)="-------------------------------------------------------------------------------"
  1. .S IBREF="" F S IBREF=$O(^TMP("IBAMTC3",$J,1,IBREF)) Q:IBREF="" D
  1. ..S CNT=CNT+1,^TMP("IBAMTC3",$J,"MSG",CNT)=$$LJ^XLFSTR(IBREF,"19T")_^TMP("IBAMTC3",$J,1,IBREF)
  1. ..Q
  1. .Q
  1. ; cancellation errors
  1. I $D(^TMP("IBAMTC3",$J,0)) D
  1. .I $D(^TMP("IBAMTC3",$J,1)) S CNT=CNT+1,^TMP("IBAMTC3",$J,"MSG",CNT)="" ; blank line between sections
  1. .S CNT=CNT+1,^TMP("IBAMTC3",$J,"MSG",CNT)="Copays not cancelled due to errors (follow up is required):"
  1. .S CNT=CNT+1,^TMP("IBAMTC3",$J,"MSG",CNT)=""
  1. .S CNT=CNT+1,^TMP("IBAMTC3",$J,"MSG",CNT)="IB Reference No. Bill Number Error message"
  1. .S CNT=CNT+1,^TMP("IBAMTC3",$J,"MSG",CNT)="-------------------------------------------------------------------------------"
  1. .S IBREF="" F S IBREF=$O(^TMP("IBAMTC3",$J,0,IBREF)) Q:IBREF="" D
  1. ..S Z=^TMP("IBAMTC3",$J,0,IBREF)
  1. ..S CNT=CNT+1,^TMP("IBAMTC3",$J,"MSG",CNT)=$$LJ^XLFSTR(IBREF,"19T")_$$LJ^XLFSTR($P(Z,U),"15T")_$E($P(Z,U,2),1,40)
  1. ..Q
  1. .Q
  1. S XMSUB="COPAY CANCELLATION REPORT (COVID RELIEF)",XMDUZ="INTEGRATED BILLING PACKAGE"
  1. S XMY("G.IB MEANS TEST")="",XMTEXT="^TMP(""IBAMTC3"","_$J_",""MSG"","
  1. D ^XMD
  1. Q