| [623] | 1 | IBCSCH1 ;ALB/MRL - BILLING HELPS (CONTINUED) ; 01 JUN 88 12:00
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**106,125,51,245,266**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;MAP TO DGCRSCH1
|
|---|
| 6 | ;
|
|---|
| 7 | 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)
|
|---|
| 8 | 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
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | 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"
|
|---|
| 12 | 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.,"
|
|---|
| 13 | W !,"enter an up-arrow, the new values will not be stored as part of this billing",!,"record." Q
|
|---|
| 14 | 3 I '$D(IBIFN),$D(DA) S IBIFN=DA
|
|---|
| 15 | W !,"If a procedure is linked as a prescription to a rev code, it cannot be deleted",!
|
|---|
| 16 | 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."
|
|---|
| 17 | I $P(^IBE(350.9,1,1),U,15)'=1 G 4
|
|---|
| 18 | S DGCODMET=$P(^DGCR(399,IBIFN,0),"^",9),DGCODMET=$S(DGCODMET=9:"ICD",DGCODMET="":"",1:"CPT")
|
|---|
| 19 | 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"
|
|---|
| 20 | I $P(^DGCR(399,IBIFN,0),"^",5)>2 W "." G 4
|
|---|
| 21 | 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."
|
|---|
| 22 | 4 W !!?4," - Enter <RETURN> to accept the default ",$S($D(IBPY):"DIAGNOSIS ",1:"PROCEDURE "),"code, or",!?7,"'^' to abort.",!!
|
|---|
| 23 | K DGCODMET
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | DISPPRC(IBIFN) ; display procedures
|
|---|
| 27 | N IBHDR,IBHDR1,IBD,IBN,IBI,IBX,IBQ,IBLN,IBPR,IBPRD,IBDT,IBDV,IBCL,IBPV,IBLC,PRCARR,IBMOD,IBSUS,IBDATE
|
|---|
| 28 | S IBQ=0
|
|---|
| 29 | ;
|
|---|
| 30 | I '$O(^DGCR(399,+$G(IBIFN),"CP",0)) W !!?5,"No Codes Entered!",! D PAUSE^VALM1 Q
|
|---|
| 31 | ;
|
|---|
| 32 | S IBDATE=$$BDATE^IBACSV(IBIFN)
|
|---|
| 33 | S IBHDR="W @IOF,!,""Procedures Assigned to this Bill"",!,""Code"",?10,""Procedure"",?35,""PO"",?38,""Date"",?48,""Div"",?55,""Clinic"",?68,""Provider"" X IBHDR1"
|
|---|
| 34 | S IBHDR1="W !,""--------------------------------------------------------------------------------"" S IBLC=2"
|
|---|
| 35 | ;
|
|---|
| 36 | X IBHDR D PRCDT^IBCU71(+IBIFN,.PRCARR)
|
|---|
| 37 | S IBD="" F S IBD=$O(PRCARR(IBD)) Q:IBD="" D Q:IBQ
|
|---|
| 38 | . S IBN="" F S IBN=$O(PRCARR(IBD,IBN)) Q:IBN="" D Q:IBQ
|
|---|
| 39 | .. 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
|
|---|
| 40 | ... S IBLN=$G(PRCARR(IBD,IBN,IBI)),(IBPR,IBPRD,IBDT,IBDV,IBCL,IBPV,IBSUS)="",IBLC=IBLC+1
|
|---|
| 41 | ... S IBX=$$PRCNM($P(IBLN,U,1),IBD),IBPR=$P(IBX,U,1),IBPRD=$P(IBX,U,2)
|
|---|
| 42 | ... S IBDT=$P(IBLN,U,2),IBDT=$E(IBDT,4,5)_"/"_$E(IBDT,6,7)_"/"_$E(IBDT,2,3)
|
|---|
| 43 | ... I +$P(IBLN,U,6) S IBDV=$P($G(^DG(40.8,+$P(IBLN,U,6),0)),U,2)
|
|---|
| 44 | ... I +$P(IBLN,U,7) S IBCL=$P($G(^SC(+$P(IBLN,U,7),0)),U,1)
|
|---|
| 45 | ... I +$P(IBLN,U,18) S IBPV=$P($G(^VA(200,+$P(IBLN,U,18),0)),U,1)
|
|---|
| 46 | ... I +$P(IBLN,U,16) S IBSUS=$P(IBLN,U,16)_"mn"
|
|---|
| 47 | ... I +$P(IBLN,U,21) S IBSUS=$P(IBLN,U,21)_"ml"
|
|---|
| 48 | ... I +$P(IBLN,U,22) S IBSUS=$P(IBLN,U,22)_"hr"
|
|---|
| 49 | ... ;
|
|---|
| 50 | ... W !,$E(IBPR,1,6),?7,$E(IBPRD,1,20),?29,IBSUS,?35,$P(IBLN,U,4),?38,IBDT,?48,IBDV,?55,$E(IBCL,1,11),?68,$E(IBPV,1,12)
|
|---|
| 51 | ... S IBX=$$MODLST^IBEFUNC2($$GETMOD^IBEFUNC(IBIFN,IBI),1,.IBX,IBD)
|
|---|
| 52 | ... I IBX'="" F IBMOD=1:1:$L(IBX,",") W !,?10,$P(IBX,",",IBMOD),?15,$P($G(IBX(1)),",",IBMOD) S IBLC=IBLC+1
|
|---|
| 53 | I 'IBI,'IBQ S IBQ=$$PAUSE(IBLC)
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | PRCNM(PRC,EFDT) ; return procedure name, input first piece of CP node -
|
|---|
| 57 | ; (in variable pointer format)
|
|---|
| 58 | ; output: code ^ name
|
|---|
| 59 | N IBNM
|
|---|
| 60 | S IBNM=$$PRCD^IBCEF1($G(PRC),1,$G(EFDT))
|
|---|
| 61 | I $TR(IBNM,U)="" D
|
|---|
| 62 | . S IBNM="NO ENTRY FOUND^"
|
|---|
| 63 | E D
|
|---|
| 64 | . S IBNM=$P(IBNM,U,2,3)
|
|---|
| 65 | Q IBNM
|
|---|
| 66 | ;
|
|---|
| 67 | PAUSE(CNT) ;
|
|---|
| 68 | N IBI F IBI=CNT:1:20 W !
|
|---|
| 69 | N DIR,DUOUT,DTOUT,DIRUT,IBX,X,Y S IBX=0,DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S IBX=1
|
|---|
| 70 | Q IBX
|
|---|
