IBCSC8.m

IBCSC8	;ALB/MJB - MCCR SCREEN 8 (UB-82 BILL SPECIFIC INFO)  ;27 MAY 88 10:20

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;;Per VHA Directive 10-93-142, this routine should not be modified.

	;

	;MAP TO DGCRSC8

	;

EN	S IBCUBFT=$$FT^IBCU3(IBIFN) I IBCUBFT=2 K IBCUBFT G ^IBCSC8H ; hcfa 1500

	I IBCUBFT=3 K IBCUBFT G ^IBCSC82 ; ub-92

	;I $P(^DGCR(399,IBIFN,0),"^",19)=2 G ^IBCSC8H ;hcfa 1500

	D ^IBCSCU S IBSR=8,IBSR1="",IBV1="00000000" S:IBV IBV1="11111111" F I="U","U1",0 S IB(I)=$S($D(^DGCR(399,IBIFN,I)):^(I),1:"")

	D H^IBCSCU

	S Z=1,IBW=1 X IBWW W " Bill Remark    : ",$S($P(IB("U1"),U,8)]"":$P(IB("U1"),U,8),1:IBUN)

	S IBX="^^^2^9^27^45" F I=4:1:7 S Z=(I-2),IBW=1 X IBWW W " Form Locator ",$P(IBX,U,I),$S($E($P(IBX,U,I),2)="":" : ",1:": "),$S($P(IB("U1"),U,I)]"":$P(IB("U1"),U,I),1:IBUN)

	S IBX=91 F I=13,14 S Z=(I-7),IBW=1,IBX=IBX+1 X IBWW W " Form Locator ",IBX,": ",$S($P(IB("U1"),U,I)]"":$P(IB("U1"),U,I),1:IBUN)

	S Z=8,IBW=1 X IBWW W " Tx Auth. Code  : ",$S($P(IB("U"),U,13)]"":$P(IB("U"),U,13),1:IBUN)

	G ^IBCSCP

Q	Q

	;IBCSC8

IBCSC8    ;ALB/MJB - MCCR SCREEN 8 (UB-82 BILL SPECIFIC INFO)  ;27 MAY 88 10:20

 +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 DGCRSC8

 +5       ;

EN        ; hcfa 1500

           SET IBCUBFT=$$FT^IBCU3(IBIFN)

           IF IBCUBFT=2

               KILL IBCUBFT

               GOTO ^IBCSC8H

 +1       ; ub-92

           IF IBCUBFT=3

               KILL IBCUBFT

               GOTO ^IBCSC82

 +2       ;I $P(^DGCR(399,IBIFN,0),"^",19)=2 G ^IBCSC8H ;hcfa 1500

 +3        DO ^IBCSCU

           SET IBSR=8

           SET IBSR1=""

           SET IBV1="00000000"

           IF IBV

               SET IBV1="11111111"

           FOR I="U","U1",0

               SET IB(I)=$SELECT($DATA(^DGCR(399,IBIFN,I)):^(I),1:"")

 +4        DO H^IBCSCU

 +5        SET Z=1

           SET IBW=1

           XECUTE IBWW

           WRITE " Bill Remark    : ",$SELECT($PIECE(IB("U1"),U,8)]"":$PIECE(IB("U1"),U,8),1:IBUN)

 +6        SET IBX="^^^2^9^27^45"

           FOR I=4:1:7

               SET Z=(I-2)

               SET IBW=1

               XECUTE IBWW

               WRITE " Form Locator ",$PIECE(IBX,U,I),$SELECT($EXTRACT($PIECE(IBX,U,I),2)="":" : ",1:": "),$SELECT($PIECE(IB("U1"),U,I)]"":$PIECE(IB("U1"),U,I),1:IBUN)

 +7        SET IBX=91

           FOR I=13,14

               SET Z=(I-7)

               SET IBW=1

               SET IBX=IBX+1

               XECUTE IBWW

               WRITE " Form Locator ",IBX,": ",$SELECT($PIECE(IB("U1"),U,I)]"":$PIECE(IB("U1"),U,I),1:IBUN)

 +8        SET Z=8

           SET IBW=1

           XECUTE IBWW

           WRITE " Tx Auth. Code  : ",$SELECT($PIECE(IB("U"),U,13)]"":$PIECE(IB("U"),U,13),1:IBUN)

 +9        GOTO ^IBCSCP

Q          QUIT 

 +1       ;IBCSC8