IBCA1.m

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