- 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 Jan 18, 2025@03:07:43 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