source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCA1.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1IBCA1 ;ALB/MRL - DISPLAY UTILITIES ;01 JUN 88 12:00
2 ;;2.0;INTEGRATED BILLING;**109**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;MAP TO DGCRA1
6 ;
7 Q:'$D(VADM) S X="",$P(X,"=",81)="" W @IOF,!,VADM(1)_" ("_$P(VADM(2),"^",2)_")",?64,"DOB: ",$P(VADM(3),"^",2),!,X
8 W !,"Rate Type",?14,": ",$S($D(^DGCR(399.3,+IBIDS(.07),0)):$P(^(0),"^",1),1:"UNSPECIFIED-REQUIRED") S IBBT=IBIDS(.04)_IBIDS(.05)_IBIDS(.06)
9 W !,"Event Date",?14,": " S Y=IBIDS(.03) X:Y ^DD("DD") W $S($L(Y):Y,1:"UNSPECIFIED"),!,"Sensitive",?14,": ",$S(IBIDS(155):"YES",IBIDS(155)=0:"NO",1:"NOT SPECIFIED")
10 W !,"Responsible",?14,": ",$S(IBIDS(.11)="p":"PATIENT",IBIDS(.11)="i":"INSURANCE CARRIER",1:"OTHER [INSTITUTION]") I "^i^o^"[("^"_IBIDS(.11)_"^") W " (Specify ",$S(IBIDS(.11)="i":"CARRIER",1:"INSTITUTION")," on SCREEN 3)"
11 W !!,"Loc of Care",?14,": ",$$EXPAND^IBTRE(399,.04,IBIDS(.04))
12 W !,"Event Source",?14,": ",$S(IBIDS(.05)<3:"Inpatient",1:"Outpatient")
13 W !,"Timeframe",?14,": ",$$EXPAND^IBTRE(399,.06,IBIDS(.06))
14 W !,?14," (Specify actual bill type fields on SCREENs 6/7)"
15 W !!,"Bill From",?14,": " S Y=IBIDS(151) X ^DD("DD") W Y,!,"Bill To",?14,": " S Y=IBIDS(152) X ^DD("DD") W Y
16 W ! I $E(IBBT,2)<3,$D(IBIDS(.08)) W !,"PTF Number",?14,": ",IBIDS(.08)
17 I $D(IBIDS(.17)) W !,"Initial Bill#",?14,": ",$S($D(^DGCR(399,+IBIDS(.17),0)):$P(^(0),"^"),1:"Bill no longer exists")
18 I $D(IBIDS(.15)) W !,"Copied Bill#",?14,": ",$S($D(^DGCR(399,+IBIDS(.15),0)):$P(^(0),"^"),1:"Bill no longer exists")
19 W ! D T
20 I $D(IBCAN),IBCAN=2 Q
21ASK S IBYN=0 W !!,"IS THE ABOVE INFORMATION CORRECT AS SHOWN" S %=1 D YN^DICN G ^IBCA:%=2,^IBCA2:%=1 I % D Q^IBCA2 G NREC^IBCA
22 W !!?4,"YES - If this information is correct as shown and you wish to file the bill.",!?4,"NO - If you wish to change this information prior to filing."
23 W !?4,"'^' - Enter the up-arrow character to DELETE this Bill at this time." G ASK
24TYPE S X3=$E(IBBT,I),X4=".0"_(I+3) W X3," - " I '$D(^DD(399,X4,0)) W "ZEROTH NODE UNSPECIFIED-CONTACT YOUR SYSTEMS MANAGER!"
25 E W $P($P($P(^DD(399,X4,0),"^",3),X3_":",2),";",1)
26 K X3,X4 Q
27T ;
28 W !,"Please verify the above information for the bill you just entered. Once this"
29 W !,"information is accepted it will no longer be editable and you will be required"
30 W !,"to CANCEL THE BILL if changes to this information are necessary."
31 Q
Note: See TracBrowser for help on using the repository browser.