- IBAMTBU2 ;ALB/CPM - MEANS TEST BILLING BULLETINS (CON'T.) ; 15-JUN-93
- ;;2.0;INTEGRATED BILLING;**153,202**;21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- MT ; Generate the 'change in Means Test' bulletin.
- W:'DGMTINF !!,"Patient's Means Test billing status has changed..."
- K IBT S IBPT=$$PT^IBEFUNC(DFN)
- S XMSUB=$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" - MEANS TEST CHANGE"
- S IBT(1)="A Means Test has been "_$S(DGMTP="":"added",DGMTA="":"deleted",1:"edited")_" for the following patient:"
- S IBT(2)=" ",IBC=2,IBDUZ=DUZ D PAT^IBAERR1 S IBC=IBC+1,IBT(IBC)=" "
- S Y=+IBMT D DD^%DT S IBC=IBC+1,IBT(IBC)="Test Date: "_Y
- S IBC=IBC+1,IBT(IBC)=" Status: "_$P($$MTS^DGMTU(DFN,+$P(IBMT,"^",3)),"^")
- I "^2^6^"[("^"_+$P(IBMT,"^",3)_"^") S IBT(IBC)=IBT(IBC)_$J("",$S($P(IBMT,"^",3)=2:11,1:21))_"Agrees to Pay Deductible? "_$S($P(IBMT,"^",11):"YES",$P(IBMT,"^",11)=0:"NO",1:"UNANSWERED")
- I $P(IBMT,"^",3)=3 D ELIG^VADPT I VAEL(3) S DIC="^DPT(",DR=.3012,DA=DFN,DIQ="IBDIQ",DIQ(0)="E" D EN^DIQ1 S IBDIQ=$G(IBDIQ(2,DFN,.3012,"E")),IBT(IBC)=IBT(IBC)_$J("",13)_"SC Award Date: "_$S(IBDIQ]"":IBDIQ,1:"Unknown")
- S Y=+$P(IBMT,"^",7) I Y D DD^%DT S IBC=IBC+1,IBT(IBC)="Completed: "_Y
- S IBC=IBC+1,IBT(IBC)=" "
- S IBC=IBC+1,IBT(IBC)="This patient is no"_$S(IBCATCA:"w",1:" longer")_" billable for medical care copayments."
- D @$S(IBCATCP:"LCHG",1:"LEP") ; build bulletin for charges or episodes
- D MAIL^IBAERR1 ; send bulletin
- W:'DGMTINF "bulletin has been generated."
- Q
- ;
- LCHG ; List charges in bulletin.
- N C,IBD,IBIL,IBN,IBND,X,Y
- S IBC=IBC+1,IBT(IBC)=$S($G(IBCANCEL):"Please note that the following charge(s) were automatically cancelled:",1:"The following charges have been billed since "_$$DAT1^IBOUTL($S(+$P(IBMT,"^",7):+$P(IBMT,"^",7),1:+IBMT))_":")
- S IBC=IBC+1,IBT(IBC)=" "
- S IBC=IBC+1,IBT(IBC)=" Bill From Bill To Charge Type Bill # Status Charge"
- S IBC=IBC+1,IBT(IBC)=$TR($J("",79)," ","=")
- ;
- ; - build detail lines
- S IBD="" F S IBD=$O(IBARR(IBD)) Q:'IBD S IBN=0 F S IBN=$O(IBARR(IBD,IBN)) Q:'IBN D
- .S IBND=$G(^IB(IBN,0)),IBIL=$P(IBND,"^",11)
- .S IBC=IBC+1,IBT(IBC)=" "_$$DAT1^IBOUTL(+$P(IBND,"^",14))_" "_$$DAT1^IBOUTL(+$P(IBND,"^",15))_" "
- .S X=$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^") S:$E(X,1,2)="DG" X=$E(X,4,99)
- .S IBT(IBC)=IBT(IBC)_X_$J("",24-$L(X))_$S(IBIL]"":$P(IBIL,"-",2)_" ",1:$J("",8))
- .S Y=$P(IBND,"^",5),C=$P(^DD(350,.05,0),"^",2) D Y^DIQ
- .S IBT(IBC)=IBT(IBC)_Y_$J("",15-$L(Y))_"$"_$P(IBND,"^",7)
- ;
- I '$G(IBCANCEL) S IBC=IBC+1,IBT(IBC)=" ",IBC=IBC+1,IBT(IBC)="Please review these charges and cancel those that should not be billed."
- Q
- ;
- LEP ; List episodes of care in bulletin.
- N IBD,IBN,IBX,X
- S IBC=IBC+1,IBT(IBC)="The following episodes of care have occurred since "_$$DAT1^IBOUTL($S(+$P(IBMT,"^",7):+$P(IBMT,"^",7),1:+IBMT))_":"
- S IBC=IBC+1,IBT(IBC)=" "
- S IBC=IBC+1,IBT(IBC)="Episode Date/Time Type of Care Ward/Clinic/Disposition/Appt Type"
- S IBC=IBC+1,IBT(IBC)=$TR($J("",79)," ","=")
- ;
- ; - build detail lines
- S IBD=0 F S IBD=$O(IBARR(IBD)) Q:'IBD S IBN="" F S IBN=$O(IBARR(IBD,IBN)) Q:IBN="" D
- .S IBX=IBARR(IBD,IBN),X=$$DAT2^IBOUTL(IBD)
- .S IBC=IBC+1,IBT(IBC)=X_$J("",23-$L(X))
- .D @$S(IBN["SC":"SC",1:IBN) S IBT(IBC)=IBT(IBC)_X
- ;
- S IBC=IBC+1,IBT(IBC)=" "
- S IBC=IBC+1,IBT(IBC)="Please review these episodes and add charges for those that should be billed."
- Q
- ;
- SC ; Build string for Stop Codes.
- S X="STOP CODE "_$E($P($G(^DIC(40.7,+IBX,0)),"^"),1,20)_" ("_$$FLD5^IBOVOP1(+$P(IBX,"^",2))_")"
- Q
- ;
- APP ; Build string for Scheduled Appointments.
- S X="APPOINTMENT "_$E($P($G(^SC(+IBX,0)),"^"),1,20)_" ("_$$FLD5^IBOVOP1(+$P(IBX,"^",2))_")"
- Q
- ;
- R ; Build string for Registrations.
- S X="REGISTRATION "_$P($G(^DIC(37,+IBX,0)),"^")
- Q
- ;
- ADM ; Build string for Admissions.
- S X="ADMISSION "_$P($G(^DIC(42,+IBX,0)),"^")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTBU2 3941 printed Feb 18, 2025@23:32:50 Page 2
- IBAMTBU2 ;ALB/CPM - MEANS TEST BILLING BULLETINS (CON'T.) ; 15-JUN-93
- +1 ;;2.0;INTEGRATED BILLING;**153,202**;21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- MT ; Generate the 'change in Means Test' bulletin.
- +1 if 'DGMTINF
- WRITE !!,"Patient's Means Test billing status has changed..."
- +2 KILL IBT
- SET IBPT=$$PT^IBEFUNC(DFN)
- +3 SET XMSUB=$EXTRACT($PIECE(IBPT,"^"),1,14)_" "_$PIECE(IBPT,"^",3)_" - MEANS TEST CHANGE"
- +4 SET IBT(1)="A Means Test has been "_$SELECT(DGMTP="":"added",DGMTA="":"deleted",1:"edited")_" for the following patient:"
- +5 SET IBT(2)=" "
- SET IBC=2
- SET IBDUZ=DUZ
- DO PAT^IBAERR1
- SET IBC=IBC+1
- SET IBT(IBC)=" "
- +6 SET Y=+IBMT
- DO DD^%DT
- SET IBC=IBC+1
- SET IBT(IBC)="Test Date: "_Y
- +7 SET IBC=IBC+1
- SET IBT(IBC)=" Status: "_$PIECE($$MTS^DGMTU(DFN,+$PIECE(IBMT,"^",3)),"^")
- +8 IF "^2^6^"[("^"_+$PIECE(IBMT,"^",3)_"^")
- SET IBT(IBC)=IBT(IBC)_$JUSTIFY("",$SELECT($PIECE(IBMT,"^",3)=2:11,1:21))_"Agrees to Pay Deductible? "_$SELECT($PIECE(IBMT,"^",11):"YES",$PIECE(IBMT,"^",11)=0:"NO",1:"UNANSWERED")
- +9 IF $PIECE(IBMT,"^",3)=3
- DO ELIG^VADPT
- IF VAEL(3)
- SET DIC="^DPT("
- SET DR=.3012
- SET DA=DFN
- SET DIQ="IBDIQ"
- SET DIQ(0)="E"
- DO EN^DIQ1
- SET IBDIQ=$GET(IBDIQ(2,DFN,.3012,"E"))
- SET IBT(IBC)=IBT(IBC)_$JUSTIFY("",13)_"SC Award Date: "_$SELECT(IBDIQ]"":IBDIQ,1:"Unknown")
- +10 SET Y=+$PIECE(IBMT,"^",7)
- IF Y
- DO DD^%DT
- SET IBC=IBC+1
- SET IBT(IBC)="Completed: "_Y
- +11 SET IBC=IBC+1
- SET IBT(IBC)=" "
- +12 SET IBC=IBC+1
- SET IBT(IBC)="This patient is no"_$SELECT(IBCATCA:"w",1:" longer")_" billable for medical care copayments."
- +13 ; build bulletin for charges or episodes
- DO @$SELECT(IBCATCP:"LCHG",1:"LEP")
- +14 ; send bulletin
- DO MAIL^IBAERR1
- +15 if 'DGMTINF
- WRITE "bulletin has been generated."
- +16 QUIT
- +17 ;
- LCHG ; List charges in bulletin.
- +1 NEW C,IBD,IBIL,IBN,IBND,X,Y
- +2 SET IBC=IBC+1
- SET IBT(IBC)=$SELECT($GET(IBCANCEL):"Please note that the following charge(s) were automatically cancelled:",1:"The following charges have been billed since "_$$DAT1^IBOUTL($SELECT(+$PIECE(IBMT,"^",7):+$PIECE(IBMT,"^",7),1:+IBMT))_":")
- +3 SET IBC=IBC+1
- SET IBT(IBC)=" "
- +4 SET IBC=IBC+1
- SET IBT(IBC)=" Bill From Bill To Charge Type Bill # Status Charge"
- +5 SET IBC=IBC+1
- SET IBT(IBC)=$TRANSLATE($JUSTIFY("",79)," ","=")
- +6 ;
- +7 ; - build detail lines
- +8 SET IBD=""
- FOR
- SET IBD=$ORDER(IBARR(IBD))
- if 'IBD
- QUIT
- SET IBN=0
- FOR
- SET IBN=$ORDER(IBARR(IBD,IBN))
- if 'IBN
- QUIT
- Begin DoDot:1
- +9 SET IBND=$GET(^IB(IBN,0))
- SET IBIL=$PIECE(IBND,"^",11)
- +10 SET IBC=IBC+1
- SET IBT(IBC)=" "_$$DAT1^IBOUTL(+$PIECE(IBND,"^",14))_" "_$$DAT1^IBOUTL(+$PIECE(IBND,"^",15))_" "
- +11 SET X=$PIECE($GET(^IBE(350.1,+$PIECE(IBND,"^",3),0)),"^")
- if $EXTRACT(X,1,2)="DG"
- SET X=$EXTRACT(X,4,99)
- +12 SET IBT(IBC)=IBT(IBC)_X_$JUSTIFY("",24-$LENGTH(X))_$SELECT(IBIL]"":$PIECE(IBIL,"-",2)_" ",1:$JUSTIFY("",8))
- +13 SET Y=$PIECE(IBND,"^",5)
- SET C=$PIECE(^DD(350,.05,0),"^",2)
- DO Y^DIQ
- +14 SET IBT(IBC)=IBT(IBC)_Y_$JUSTIFY("",15-$LENGTH(Y))_"$"_$PIECE(IBND,"^",7)
- End DoDot:1
- +15 ;
- +16 IF '$GET(IBCANCEL)
- SET IBC=IBC+1
- SET IBT(IBC)=" "
- SET IBC=IBC+1
- SET IBT(IBC)="Please review these charges and cancel those that should not be billed."
- +17 QUIT
- +18 ;
- LEP ; List episodes of care in bulletin.
- +1 NEW IBD,IBN,IBX,X
- +2 SET IBC=IBC+1
- SET IBT(IBC)="The following episodes of care have occurred since "_$$DAT1^IBOUTL($SELECT(+$PIECE(IBMT,"^",7):+$PIECE(IBMT,"^",7),1:+IBMT))_":"
- +3 SET IBC=IBC+1
- SET IBT(IBC)=" "
- +4 SET IBC=IBC+1
- SET IBT(IBC)="Episode Date/Time Type of Care Ward/Clinic/Disposition/Appt Type"
- +5 SET IBC=IBC+1
- SET IBT(IBC)=$TRANSLATE($JUSTIFY("",79)," ","=")
- +6 ;
- +7 ; - build detail lines
- +8 SET IBD=0
- FOR
- SET IBD=$ORDER(IBARR(IBD))
- if 'IBD
- QUIT
- SET IBN=""
- FOR
- SET IBN=$ORDER(IBARR(IBD,IBN))
- if IBN=""
- QUIT
- Begin DoDot:1
- +9 SET IBX=IBARR(IBD,IBN)
- SET X=$$DAT2^IBOUTL(IBD)
- +10 SET IBC=IBC+1
- SET IBT(IBC)=X_$JUSTIFY("",23-$LENGTH(X))
- +11 DO @$SELECT(IBN["SC":"SC",1:IBN)
- SET IBT(IBC)=IBT(IBC)_X
- End DoDot:1
- +12 ;
- +13 SET IBC=IBC+1
- SET IBT(IBC)=" "
- +14 SET IBC=IBC+1
- SET IBT(IBC)="Please review these episodes and add charges for those that should be billed."
- +15 QUIT
- +16 ;
- SC ; Build string for Stop Codes.
- +1 SET X="STOP CODE "_$EXTRACT($PIECE($GET(^DIC(40.7,+IBX,0)),"^"),1,20)_" ("_$$FLD5^IBOVOP1(+$PIECE(IBX,"^",2))_")"
- +2 QUIT
- +3 ;
- APP ; Build string for Scheduled Appointments.
- +1 SET X="APPOINTMENT "_$EXTRACT($PIECE($GET(^SC(+IBX,0)),"^"),1,20)_" ("_$$FLD5^IBOVOP1(+$PIECE(IBX,"^",2))_")"
- +2 QUIT
- +3 ;
- R ; Build string for Registrations.
- +1 SET X="REGISTRATION "_$PIECE($GET(^DIC(37,+IBX,0)),"^")
- +2 QUIT
- +3 ;
- ADM ; Build string for Admissions.
- +1 SET X="ADMISSION "_$PIECE($GET(^DIC(42,+IBX,0)),"^")
- +2 QUIT