- IBCSCH1 ;ALB/MRL - BILLING HELPS (CONTINUED) ;01 JUN 88 12:00
- ;;2.0;INTEGRATED BILLING;**106,125,51,245,266,395,458,461**;21-MAR-94;Build 58
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;MAP TO DGCRSCH1
- ;
- 1 W !!,"DO YOU WISH TO ADD/EDIT INSURANCE COMPANY DATA FOR THIS PATIENT" S %=2 D YN^DICN S IBADI=$S(%=1!(%=-1):%,1:0)
- I '% W !!?4,"YES - And I'll prompt you so that you may add insurance data to the PATIENT",!?9,"file for this patient.",!?4,"NO - To bypass this editing of the PATIENT file." G 1
- Q
- ;
- 2 W !!,"If you updated insurance information for any policy which is already specified",!,"as either a PRIMARY, SECONDARY or TERIARY for this billing episode, you will"
- W !,"need to press the <RETURN> key through the following prompts in order to insure",!,"that these new values are properly stored. If you fail to do so, i.e.,"
- W !,"enter an up-arrow, the new values will not be stored as part of this billing",!,"record." Q
- 3 I '$D(IBIFN),$D(DA) S IBIFN=DA
- W !,"If a procedure is linked as a prescription to a rev code, it cannot be deleted",!
- W:$P(^DGCR(399,IBIFN,0),"^",5)<3 !!?4," - Enter the alphanumeric designation of your choice from",!?7,"the display (e.g. 'A1') to input one of the codes shown",!?7,"above into this billing record."
- I $P(^IBE(350.9,1,1),U,15)'=1 G 4
- S DGCODMET=$P(^DGCR(399,IBIFN,0),"^",9),DGCODMET=$S(DGCODMET=9:"ICD",DGCODMET="":"",1:"CPT")
- W !!?4," - Enter the name or code number of an ",$S($D(IBPY):"ICD DIAGNOSIS ",1:DGCODMET_" PROCEDURE "),"CODE",!?7,"not displayed above to input a ",$S($D(IBPY):"DIAGNOSIS",1:"PROCEDURE")," code"
- I $P(^DGCR(399,IBIFN,0),"^",5)>2 W "." G 4
- W " not found",!?7,"in the PTF record into this billing record, or '??' for ",!?7,"a list of all ",$S($D(IBPY):"ICD DIAGNOSIS ",1:DGCODMET_" PROCEDURE "),"CODES."
- 4 W !!?4," - Enter <RETURN> to accept the default ",$S($D(IBPY):"DIAGNOSIS ",1:"PROCEDURE "),"code, or",!?7,"'^' to abort.",!!
- K DGCODMET
- Q
- ;
- DISPPRC(IBIFN) ; display procedures
- N IBHDR,IBHDR1,IBD,IBN,IBI,IBX,IBQ,IBLN,IBPR,IBPRD,IBDT,IBDV,IBCL,IBPV,IBLC,PRCARR,IBMOD,IBSUS,IBDATE
- S IBQ=0
- ;
- I '$O(^DGCR(399,+$G(IBIFN),"CP",0)) W !!?5,"No Codes Entered!",! D PAUSE^VALM1 Q
- ;
- S IBDATE=$$BDATE^IBACSV(IBIFN)
- S IBHDR="W @IOF,!,""Procedures Assigned to this Bill"",!,""Code"",?10,""Procedure"",?35,""PO"",?38,""Date"",?48,""Div"",?55,""Clinic"",?68,""Provider"" X IBHDR1"
- S IBHDR1="W !,""--------------------------------------------------------------------------------"" S IBLC=2"
- ;
- X IBHDR D PRCDT^IBCU71(+IBIFN,.PRCARR)
- S IBD="" F S IBD=$O(PRCARR(IBD)) Q:IBD="" D Q:IBQ
- . S IBN="" F S IBN=$O(PRCARR(IBD,IBN)) Q:IBN="" D Q:IBQ
- .. S IBI=0 F S IBI=$O(PRCARR(IBD,IBN,IBI)) Q:'IBI D I IBLC>19 S IBQ=$$PAUSE(IBLC) Q:IBQ X IBHDR
- ... S IBLN=$G(PRCARR(IBD,IBN,IBI)),(IBPR,IBPRD,IBDT,IBDV,IBCL,IBPV,IBSUS)="",IBLC=IBLC+1
- ... S IBX=$$PRCNM($P(IBLN,U,1),IBD),IBPR=$P(IBX,U,1),IBPRD=$P(IBX,U,2)
- ... S IBDT=$P(IBLN,U,2),IBDT=$E(IBDT,4,5)_"/"_$E(IBDT,6,7)_"/"_$E(IBDT,2,3)
- ... I +$P(IBLN,U,6) S IBDV=$P($G(^DG(40.8,+$P(IBLN,U,6),0)),U,2)
- ... I +$P(IBLN,U,7) S IBCL=$P($G(^SC(+$P(IBLN,U,7),0)),U,1)
- ... I +$P(IBLN,U,18) S IBPV=$P($G(^VA(200,+$P(IBLN,U,18),0)),U,1)
- ... I +$P(IBLN,U,16) S IBSUS=$P(IBLN,U,16)_"mn"
- ... I +$P(IBLN,U,21) S IBSUS=$P(IBLN,U,21)_"ml"
- ... I +$P(IBLN,U,22) S IBSUS=$P(IBLN,U,22)_"hr"
- ... ;
- ... W !,$E(IBPR,1,7),?8,$E(IBPRD,1,19),?29,IBSUS,?35,$P(IBLN,U,4),?38,IBDT,?48,IBDV,?55,$E(IBCL,1,11),?68,$E(IBPV,1,12)
- ... S IBX=$$MODLST^IBEFUNC2($$GETMOD^IBEFUNC(IBIFN,IBI),1,.IBX,IBD)
- ... I IBX'="" F IBMOD=1:1:$L(IBX,",") W !,?10,$P(IBX,",",IBMOD),?15,$P($G(IBX(1)),",",IBMOD) S IBLC=IBLC+1
- I 'IBI,'IBQ S IBQ=$$PAUSE(IBLC)
- Q
- ;
- PRCNM(PRC,EFDT) ; return procedure name, input first piece of CP node -
- ; (in variable pointer format)
- ; output: code ^ name
- N IBNM
- S IBNM=$$PRCD^IBCEF1($G(PRC),1,$G(EFDT))
- I $TR(IBNM,U)="" D
- . S IBNM="NO ENTRY FOUND^"
- E D
- . S IBNM=$P(IBNM,U,2,3)
- Q IBNM
- ;
- PAUSE(CNT) ;
- N IBI F IBI=CNT:1:20 W !
- N DIR,DUOUT,DTOUT,DIRUT,IBX,X,Y S IBX=0,DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S IBX=1
- Q IBX
- ;
- DISPRX(IBIFN) ; display prescriptions
- N IBHDR,IBHDR1,IBX,IBZ,IBRXL,IBNPI,IBRX,IBQ,IBORG
- S IBQ=0
- ;
- I '$O(^IBA(362.4,"AIFN"_IBIFN,0)) W !!?5,"No Prescriptions Entered!",! D PAUSE^VALM1 Q
- ;
- ; get NPIs
- S IBX=$$RXSITE^IBCEF73A(IBIFN,.IBRXL)
- ;
- S IBHDR="W @IOF,!,""Prescriptions Assigned to this Bill"" X IBHDR1"
- S IBHDR1="W !,""--------------------------------------------------------------------------------"" "
- ;
- X IBHDR
- S IBRX=0 F S IBRX=$O(^IBA(362.4,"AIFN"_IBIFN,IBRX)) Q:'IBRX!(IBQ) S IBX=0 F S IBX=$O(^IBA(362.4,"AIFN"_IBIFN,IBRX,IBX)) Q:'IBX!(IBQ) D
- . S IBZ=$G(^IBA(362.4,IBX,0))
- . W !?5,"RX #: ",$P(IBZ,"^")
- . W ?50,"DATE: ",$$FMTE^XLFDT($P(IBZ,"^",3))
- . W !?5,"DRUG: ",$$EXTERNAL^DILFD(362.4,.04,"",$P(IBZ,"^",4))
- . W ?50,"NDC: ",$P(IBZ,"^",8)
- . W !?5,"DAYS SUPPLY: ",$P(IBZ,"^",6)
- . W ?50,"QUANTITY: ",$P(IBZ,"^",7)
- . S IBORG=$G(IBRXL(+$P(IBZ,"^",5),+$P(IBZ,"^",3)))
- . ; ia #4532
- . S IBNPI=$S(IBORG:$P($$NPI^XUSNPI("Organization_ID",IBORG),U),1:"")
- . W !?5,"NPI INSTITUTION: ",$S(IBORG:$$EXTERNAL^DILFD(350.9,.02,"",IBORG),1:"")
- . W ?50,"RX NPI: ",$S(IBNPI>0:IBNPI,1:"")
- . W !?5,"PROVIDER: ",$S($P(IBZ,"^",5):$$RXAPI1^IBNCPUT1($P(IBZ,"^",5),4),1:""),!
- . I $Y+7>IOSL S IBQ=$$PAUSE(0)
- D PAUSE^VALM1
- ;
- Q
- ;
- EDITRNB(IBIFN) ; add/edit RNB and Comments for CT entries associated with bill, ?RNB Help function
- ; sets IBNOCANC indicating bill not cancelled, function sets it to number of associated CT entries
- N IBNOCANC S IBNOCANC=0 I '$G(IBIFN) Q
- W @IOF,!,"Reason Not Billable for Claims Tracking Entries associated with this Bill:",!,$TR($J(" ",74)," ","-")
- W !!,"Episodes not fully billed may have a Reason Not Billable entered on the Claims",!,"Tracking entry. Only enter an RNB if the episode is not fully billed.",!
- ;
- D ^IBCC1 I '$G(IBNOCANC) W !!,"No associated Claims Tracking entries found.",!!
- ;
- D PAUSE(19)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCSCH1 6106 printed Feb 18, 2025@23:46:54 Page 2
- IBCSCH1 ;ALB/MRL - BILLING HELPS (CONTINUED) ;01 JUN 88 12:00
- +1 ;;2.0;INTEGRATED BILLING;**106,125,51,245,266,395,458,461**;21-MAR-94;Build 58
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;MAP TO DGCRSCH1
- +5 ;
- 1 WRITE !!,"DO YOU WISH TO ADD/EDIT INSURANCE COMPANY DATA FOR THIS PATIENT"
- SET %=2
- DO YN^DICN
- SET IBADI=$SELECT(%=1!(%=-1):%,1:0)
- +1 IF '%
- WRITE !!?4,"YES - And I'll prompt you so that you may add insurance data to the PATIENT",!?9,"file for this patient.",!?4,"NO - To bypass this editing of the PATIENT file."
- GOTO 1
- +2 QUIT
- +3 ;
- 2 WRITE !!,"If you updated insurance information for any policy which is already specified",!,"as either a PRIMARY, SECONDARY or TERIARY for this billing episode, you will"
- +1 WRITE !,"need to press the <RETURN> key through the following prompts in order to insure",!,"that these new values are properly stored. If you fail to do so, i.e.,"
- +2 WRITE !,"enter an up-arrow, the new values will not be stored as part of this billing",!,"record."
- QUIT
- 3 IF '$DATA(IBIFN)
- IF $DATA(DA)
- SET IBIFN=DA
- +1 WRITE !,"If a procedure is linked as a prescription to a rev code, it cannot be deleted",!
- +2 if $PIECE(^DGCR(399,IBIFN,0),"^",5)<3
- WRITE !!?4," - Enter the alphanumeric designation of your choice from",!?7,"the display (e.g. 'A1') to input one of the codes shown",!?7,"above into this billing record."
- +3 IF $PIECE(^IBE(350.9,1,1),U,15)'=1
- GOTO 4
- +4 SET DGCODMET=$PIECE(^DGCR(399,IBIFN,0),"^",9)
- SET DGCODMET=$SELECT(DGCODMET=9:"ICD",DGCODMET="":"",1:"CPT")
- +5 WRITE !!?4," - Enter the name or code number of an ",$SELECT($DATA(IBPY):"ICD DIAGNOSIS ",1:DGCODMET_" PROCEDURE "),"CODE",!?7,"not displayed above to input a ",$SELECT($DATA(IBPY):"DIAGNOSIS",1:"PROCEDURE")," code"
- +6 IF $PIECE(^DGCR(399,IBIFN,0),"^",5)>2
- WRITE "."
- GOTO 4
- +7 WRITE " not found",!?7,"in the PTF record into this billing record, or '??' for ",!?7,"a list of all ",$SELECT($DATA(IBPY):"ICD DIAGNOSIS ",1:DGCODMET_" PROCEDURE "),"CODES."
- 4 WRITE !!?4," - Enter <RETURN> to accept the default ",$SELECT($DATA(IBPY):"DIAGNOSIS ",1:"PROCEDURE "),"code, or",!?7,"'^' to abort.",!!
- +1 KILL DGCODMET
- +2 QUIT
- +3 ;
- DISPPRC(IBIFN) ; display procedures
- +1 NEW IBHDR,IBHDR1,IBD,IBN,IBI,IBX,IBQ,IBLN,IBPR,IBPRD,IBDT,IBDV,IBCL,IBPV,IBLC,PRCARR,IBMOD,IBSUS,IBDATE
- +2 SET IBQ=0
- +3 ;
- +4 IF '$ORDER(^DGCR(399,+$GET(IBIFN),"CP",0))
- WRITE !!?5,"No Codes Entered!",!
- DO PAUSE^VALM1
- QUIT
- +5 ;
- +6 SET IBDATE=$$BDATE^IBACSV(IBIFN)
- +7 SET IBHDR="W @IOF,!,""Procedures Assigned to this Bill"",!,""Code"",?10,""Procedure"",?35,""PO"",?38,""Date"",?48,""Div"",?55,""Clinic"",?68,""Provider"" X IBHDR1"
- +8 SET IBHDR1="W !,""--------------------------------------------------------------------------------"" S IBLC=2"
- +9 ;
- +10 XECUTE IBHDR
- DO PRCDT^IBCU71(+IBIFN,.PRCARR)
- +11 SET IBD=""
- FOR
- SET IBD=$ORDER(PRCARR(IBD))
- if IBD=""
- QUIT
- Begin DoDot:1
- +12 SET IBN=""
- FOR
- SET IBN=$ORDER(PRCARR(IBD,IBN))
- if IBN=""
- QUIT
- Begin DoDot:2
- +13 SET IBI=0
- FOR
- SET IBI=$ORDER(PRCARR(IBD,IBN,IBI))
- if 'IBI
- QUIT
- Begin DoDot:3
- +14 SET IBLN=$GET(PRCARR(IBD,IBN,IBI))
- SET (IBPR,IBPRD,IBDT,IBDV,IBCL,IBPV,IBSUS)=""
- SET IBLC=IBLC+1
- +15 SET IBX=$$PRCNM($PIECE(IBLN,U,1),IBD)
- SET IBPR=$PIECE(IBX,U,1)
- SET IBPRD=$PIECE(IBX,U,2)
- +16 SET IBDT=$PIECE(IBLN,U,2)
- SET IBDT=$EXTRACT(IBDT,4,5)_"/"_$EXTRACT(IBDT,6,7)_"/"_$EXTRACT(IBDT,2,3)
- +17 IF +$PIECE(IBLN,U,6)
- SET IBDV=$PIECE($GET(^DG(40.8,+$PIECE(IBLN,U,6),0)),U,2)
- +18 IF +$PIECE(IBLN,U,7)
- SET IBCL=$PIECE($GET(^SC(+$PIECE(IBLN,U,7),0)),U,1)
- +19 IF +$PIECE(IBLN,U,18)
- SET IBPV=$PIECE($GET(^VA(200,+$PIECE(IBLN,U,18),0)),U,1)
- +20 IF +$PIECE(IBLN,U,16)
- SET IBSUS=$PIECE(IBLN,U,16)_"mn"
- +21 IF +$PIECE(IBLN,U,21)
- SET IBSUS=$PIECE(IBLN,U,21)_"ml"
- +22 IF +$PIECE(IBLN,U,22)
- SET IBSUS=$PIECE(IBLN,U,22)_"hr"
- +23 ;
- +24 WRITE !,$EXTRACT(IBPR,1,7),?8,$EXTRACT(IBPRD,1,19),?29,IBSUS,?35,$PIECE(IBLN,U,4),?38,IBDT,?48,IBDV,?55,$EXTRACT(IBCL,1,11),?68,$EXTRACT(IBPV,1,12)
- +25 SET IBX=$$MODLST^IBEFUNC2($$GETMOD^IBEFUNC(IBIFN,IBI),1,.IBX,IBD)
- +26 IF IBX'=""
- FOR IBMOD=1:1:$LENGTH(IBX,",")
- WRITE !,?10,$PIECE(IBX,",",IBMOD),?15,$PIECE($GET(IBX(1)),",",IBMOD)
- SET IBLC=IBLC+1
- End DoDot:3
- IF IBLC>19
- SET IBQ=$$PAUSE(IBLC)
- if IBQ
- QUIT
- XECUTE IBHDR
- End DoDot:2
- if IBQ
- QUIT
- End DoDot:1
- if IBQ
- QUIT
- +27 IF 'IBI
- IF 'IBQ
- SET IBQ=$$PAUSE(IBLC)
- +28 QUIT
- +29 ;
- PRCNM(PRC,EFDT) ; return procedure name, input first piece of CP node -
- +1 ; (in variable pointer format)
- +2 ; output: code ^ name
- +3 NEW IBNM
- +4 SET IBNM=$$PRCD^IBCEF1($GET(PRC),1,$GET(EFDT))
- +5 IF $TRANSLATE(IBNM,U)=""
- Begin DoDot:1
- +6 SET IBNM="NO ENTRY FOUND^"
- End DoDot:1
- +7 IF '$TEST
- Begin DoDot:1
- +8 SET IBNM=$PIECE(IBNM,U,2,3)
- End DoDot:1
- +9 QUIT IBNM
- +10 ;
- PAUSE(CNT) ;
- +1 NEW IBI
- FOR IBI=CNT:1:20
- WRITE !
- +2 NEW DIR,DUOUT,DTOUT,DIRUT,IBX,X,Y
- SET IBX=0
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET IBX=1
- +3 QUIT IBX
- +4 ;
- DISPRX(IBIFN) ; display prescriptions
- +1 NEW IBHDR,IBHDR1,IBX,IBZ,IBRXL,IBNPI,IBRX,IBQ,IBORG
- +2 SET IBQ=0
- +3 ;
- +4 IF '$ORDER(^IBA(362.4,"AIFN"_IBIFN,0))
- WRITE !!?5,"No Prescriptions Entered!",!
- DO PAUSE^VALM1
- QUIT
- +5 ;
- +6 ; get NPIs
- +7 SET IBX=$$RXSITE^IBCEF73A(IBIFN,.IBRXL)
- +8 ;
- +9 SET IBHDR="W @IOF,!,""Prescriptions Assigned to this Bill"" X IBHDR1"
- +10 SET IBHDR1="W !,""--------------------------------------------------------------------------------"" "
- +11 ;
- +12 XECUTE IBHDR
- +13 SET IBRX=0
- FOR
- SET IBRX=$ORDER(^IBA(362.4,"AIFN"_IBIFN,IBRX))
- if 'IBRX!(IBQ)
- QUIT
- SET IBX=0
- FOR
- SET IBX=$ORDER(^IBA(362.4,"AIFN"_IBIFN,IBRX,IBX))
- if 'IBX!(IBQ)
- QUIT
- Begin DoDot:1
- +14 SET IBZ=$GET(^IBA(362.4,IBX,0))
- +15 WRITE !?5,"RX #: ",$PIECE(IBZ,"^")
- +16 WRITE ?50,"DATE: ",$$FMTE^XLFDT($PIECE(IBZ,"^",3))
- +17 WRITE !?5,"DRUG: ",$$EXTERNAL^DILFD(362.4,.04,"",$PIECE(IBZ,"^",4))
- +18 WRITE ?50,"NDC: ",$PIECE(IBZ,"^",8)
- +19 WRITE !?5,"DAYS SUPPLY: ",$PIECE(IBZ,"^",6)
- +20 WRITE ?50,"QUANTITY: ",$PIECE(IBZ,"^",7)
- +21 SET IBORG=$GET(IBRXL(+$PIECE(IBZ,"^",5),+$PIECE(IBZ,"^",3)))
- +22 ; ia #4532
- +23 SET IBNPI=$SELECT(IBORG:$PIECE($$NPI^XUSNPI("Organization_ID",IBORG),U),1:"")
- +24 WRITE !?5,"NPI INSTITUTION: ",$SELECT(IBORG:$$EXTERNAL^DILFD(350.9,.02,"",IBORG),1:"")
- +25 WRITE ?50,"RX NPI: ",$SELECT(IBNPI>0:IBNPI,1:"")
- +26 WRITE !?5,"PROVIDER: ",$SELECT($PIECE(IBZ,"^",5):$$RXAPI1^IBNCPUT1($PIECE(IBZ,"^",5),4),1:""),!
- +27 IF $Y+7>IOSL
- SET IBQ=$$PAUSE(0)
- End DoDot:1
- +28 DO PAUSE^VALM1
- +29 ;
- +30 QUIT
- +31 ;
- EDITRNB(IBIFN) ; add/edit RNB and Comments for CT entries associated with bill, ?RNB Help function
- +1 ; sets IBNOCANC indicating bill not cancelled, function sets it to number of associated CT entries
- +2 NEW IBNOCANC
- SET IBNOCANC=0
- IF '$GET(IBIFN)
- QUIT
- +3 WRITE @IOF,!,"Reason Not Billable for Claims Tracking Entries associated with this Bill:",!,$TRANSLATE($JUSTIFY(" ",74)," ","-")
- +4 WRITE !!,"Episodes not fully billed may have a Reason Not Billable entered on the Claims",!,"Tracking entry. Only enter an RNB if the episode is not fully billed.",!
- +5 ;
- +6 DO ^IBCC1
- IF '$GET(IBNOCANC)
- WRITE !!,"No associated Claims Tracking entries found.",!!
- +7 ;
- +8 DO PAUSE(19)
- +9 QUIT