IBCAMS.m

IBCAMS	;ALB/AAS - DETERMINE AMIS SEGMENT FOR REIMBURSABLE INS BILLS ; 10-SEP-91

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

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

	;

	;MAP TO DGCRAMS

	;

AMIS	;  - calculate AMIS segment for insurance bills.

	;    249 = NSC - outpatient

	;    292 = SC  - inpatient

	;    293 = SC  - outpatient

	;    297 = NSC - inpatient

	;  - input

	;       x = internal number of entry in 399

	;

	;  - output

	;       y = amis segment number or -1 if can't determine

	;

%	S Y=-1

	I '$D(^DGCR(399,+X,0)) G AMISQ

	S IBX=^DGCR(399,+X,0)

	N DFN

	;

	;  - make sure is RI bill

	;S R=$P(IBX,"^",7),R=$S('$D(^DGCR(399.3,+R,0)):0,1:$P(^(0),"^",6)) G:'R AMISQ S R=$S('$D(^PRCA(430.2,+R,0)):0,1:$P(^(0),"^",7)) G:R'=21 AMISQ

	G:+$$CAT^PRCAFN(X)'=21 AMISQ

	;

	S IBI=$P(IBX,"^",5),IBI=$S('IBI:0,IBI>2:2,IBI<3:1,1:0) G:'IBI AMISQ ; 0=err, 1=inpatient, 2=outpatient

	;

	N X

	S IBSC=$P(IBX,"^",18),DFN=$P(IBX,"^",2) I IBSC="" D ELIG^VADPT S IBSC=+VAEL(3)

	;

	;  - compute amis segment

	S:+IBSC Y=$S(IBI=1:292,IBI=2:293,1:-1) ;sc amis segments

	S:'IBSC Y=$S(IBI=1:297,IBI=2:249,1:-1) ;nsc amis segments

	;

AMISQ	K IBSC,IBX,IBI,VAEL,VAERR

	Q

IBCAMS    ;ALB/AAS - DETERMINE AMIS SEGMENT FOR REIMBURSABLE INS BILLS ; 10-SEP-91

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

 +5       ;

AMIS      ;  - calculate AMIS segment for insurance bills.

 +1       ;    249 = NSC - outpatient

 +2       ;    292 = SC  - inpatient

 +3       ;    293 = SC  - outpatient

 +4       ;    297 = NSC - inpatient

 +5       ;  - input

 +6       ;       x = internal number of entry in 399

 +7       ;

 +8       ;  - output

 +9       ;       y = amis segment number or -1 if can't determine

 +10      ;

%          SET Y=-1

 +1        IF '$DATA(^DGCR(399,+X,0))

               GOTO AMISQ

 +2        SET IBX=^DGCR(399,+X,0)

 +3        NEW DFN

 +4       ;

 +5       ;  - make sure is RI bill

 +6       ;S R=$P(IBX,"^",7),R=$S('$D(^DGCR(399.3,+R,0)):0,1:$P(^(0),"^",6)) G:'R AMISQ S R=$S('$D(^PRCA(430.2,+R,0)):0,1:$P(^(0),"^",7)) G:R'=21 AMISQ

 +7        IF +$$CAT^PRCAFN(X)'=21

               GOTO AMISQ

 +8       ;

 +9       ; 0=err, 1=inpatient, 2=outpatient

           SET IBI=$PIECE(IBX,"^",5)

           SET IBI=$SELECT('IBI:0,IBI>2:2,IBI<3:1,1:0)

           IF 'IBI

               GOTO AMISQ

 +10      ;

 +11       NEW X

 +12       SET IBSC=$PIECE(IBX,"^",18)

           SET DFN=$PIECE(IBX,"^",2)

           IF IBSC=""

               DO ELIG^VADPT

               SET IBSC=+VAEL(3)

 +13      ;

 +14      ;  - compute amis segment

 +15      ;sc amis segments

           IF +IBSC

               SET Y=$SELECT(IBI=1:292,IBI=2:293,1:-1)

 +16      ;nsc amis segments

           IF 'IBSC

               SET Y=$SELECT(IBI=1:297,IBI=2:249,1:-1)

 +17      ;

AMISQ      KILL IBSC,IBX,IBI,VAEL,VAERR

 +1        QUIT