- IBCA1 ;ALB/MRL - DISPLAY UTILITIES ;01 JUN 88 12:00
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;MAP TO DGCRA1
- ;
- Q:'$D(VADM) S X="",$P(X,"=",81)="" W @IOF,!,VADM(1)_" ("_$P(VADM(2),"^",2)_")",?64,"DOB: ",$P(VADM(3),"^",2),!,X
- W !,"Rate Type",?13,": ",$S($D(^DGCR(399.3,+IBIDS(.07),0)):$P(^(0),"^",1),1:"UNSPECIFIED-REQUIRED") S IBBT=IBIDS(.04)_IBIDS(.05)_IBIDS(.06)
- W !,"Event Date",?13,": " S Y=IBIDS(.03) X:Y ^DD("DD") W $S($L(Y):Y,1:"UNSPECIFIED"),!,"Sensitive",?13,": ",$S(IBIDS(155):"YES",IBIDS(155)=0:"NO",1:"NOT SPECIFIED")
- W !,"Responsible",?13,": ",$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)"
- W !!,"Bill Type",?13,": ",IBBT F I=1:1:3 W !," o "_I_$S(I=1:"st",I=2:"nd",1:"rd")_" Digit",?13,": " D TYPE
- W !!,"Bill From",?13,": " S Y=IBIDS(151) X ^DD("DD") W Y,!,"Bill To",?13,": " S Y=IBIDS(152) X ^DD("DD") W Y
- W ! I $E(IBBT,2)<3,$D(IBIDS(.08)) W !,"PTF Number",?13,": ",IBIDS(.08)
- I $D(IBIDS(.17)) W !,"Initial Bill#",?13,": ",$S($D(^DGCR(399,+IBIDS(.17),0)):$P(^(0),"^"),1:"Bill no longer exists")
- I $D(IBIDS(.15)) W !,"Copied Bill#",?13,": ",$S($D(^DGCR(399,+IBIDS(.15),0)):$P(^(0),"^"),1:"Bill no longer exists")
- W ! D T
- I $D(IBCAN),IBCAN=2 Q
- ASK 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
- 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."
- W !?4,"'^' - Enter the up-arrow character to DELETE this Bill at this time." G ASK
- TYPE 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!"
- E W $P($P($P(^DD(399,X4,0),"^",3),X3_":",2),";",1)
- K X3,X4 Q
- T ;
- W !,"Please verify the above information for the bill you just entered. Once this"
- W !,"information is accepted it will no longer be editable and you will be required"
- W !,"to CANCEL THE BILL if changes to this information are necessary."
- Q
- IBCA1 ;ALB/MRL - DISPLAY UTILITIES ;01 JUN 88 12:00
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;MAP TO DGCRA1
- +5 ;
- +6 IF '$DATA(VADM)
- QUIT
- SET X=""
- SET $PIECE(X,"=",81)=""
- WRITE @IOF,!,VADM(1)_" ("_$PIECE(VADM(2),"^",2)_")",?64,"DOB: ",$PIECE(VADM(3),"^",2),!,X
- +7 WRITE !,"Rate Type",?13,": ",$SELECT($DATA(^DGCR(399.3,+IBIDS(.07),0)):$PIECE(^(0),"^",1),1:"UNSPECIFIED-REQUIRED")
- SET IBBT=IBIDS(.04)_IBIDS(.05)_IBIDS(.06)
- +8 WRITE !,"Event Date",?13,": "
- SET Y=IBIDS(.03)
- IF Y
- XECUTE ^DD("DD")
- WRITE $SELECT($LENGTH(Y):Y,1:"UNSPECIFIED"),!,"Sensitive",?13,": ",$SELECT(IBIDS(155):"YES",IBIDS(155)=0:"NO",1:"NOT SPECIFIED")
- +9 WRITE !,"Responsible",?13,": ",$SELECT(IBIDS(.11)="p":"PATIENT",IBIDS(.11)="i":"INSURANCE CARRIER",1:"OTHER [INSTITUTION]")
- IF "^i^o^"[("^"_IBIDS(.11)_"^")
- WRITE " (Specify ",$SELECT(IBIDS(.11)="i":"CARRIER",1:"INSTITUTION")," on SCREEN 3)"
- +10 WRITE !!,"Bill Type",?13,": ",IBBT
- FOR I=1:1:3
- WRITE !," o "_I_$SELECT(I=1:"st",I=2:"nd",1:"rd")_" Digit",?13,": "
- DO TYPE
- +11 WRITE !!,"Bill From",?13,": "
- SET Y=IBIDS(151)
- XECUTE ^DD("DD")
- WRITE Y,!,"Bill To",?13,": "
- SET Y=IBIDS(152)
- XECUTE ^DD("DD")
- WRITE Y
- +12 WRITE !
- IF $EXTRACT(IBBT,2)<3
- IF $DATA(IBIDS(.08))
- WRITE !,"PTF Number",?13,": ",IBIDS(.08)
- +13 IF $DATA(IBIDS(.17))
- WRITE !,"Initial Bill#",?13,": ",$SELECT($DATA(^DGCR(399,+IBIDS(.17),0)):$PIECE(^(0),"^"),1:"Bill no longer exists")
- +14 IF $DATA(IBIDS(.15))
- WRITE !,"Copied Bill#",?13,": ",$SELECT($DATA(^DGCR(399,+IBIDS(.15),0)):$PIECE(^(0),"^"),1:"Bill no longer exists")
- +15 WRITE !
- DO T
- +16 IF $DATA(IBCAN)
- IF IBCAN=2
- QUIT
- ASK SET IBYN=0
- WRITE !!,"IS THE ABOVE INFORMATION CORRECT AS SHOWN"
- SET %=1
- DO YN^DICN
- IF %=2
- GOTO ^IBCA
- IF %=1
- GOTO ^IBCA2
- IF %
- DO Q^IBCA2
- GOTO NREC^IBCA
- +1 WRITE !!?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."
- +2 WRITE !?4,"'^' - Enter the up-arrow character to DELETE this Bill at this time."
- GOTO ASK
- TYPE SET X3=$EXTRACT(IBBT,I)
- SET X4=".0"_(I+3)
- WRITE X3," - "
- IF '$DATA(^DD(399,X4,0))
- WRITE "ZEROTH NODE UNSPECIFIED-CONTACT YOUR SYSTEMS MANAGER!"
- +1 IF '$TEST
- WRITE $PIECE($PIECE($PIECE(^DD(399,X4,0),"^",3),X3_":",2),";",1)
- +2 KILL X3,X4
- QUIT
- T ;
- +1 WRITE !,"Please verify the above information for the bill you just entered. Once this"
- +2 WRITE !,"information is accepted it will no longer be editable and you will be required"
- +3 WRITE !,"to CANCEL THE BILL if changes to this information are necessary."
- +4 QUIT
