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