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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCAMS 1214 printed Dec 13, 2024@02:08:32 Page 2
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
