- IBOHLD2 ;ALB/CJM - REPORT OF CHARGES ON HOLD W/INS ;MAR 6,1991
- ;;2.0;INTEGRATED BILLING;**70,95,133,153,347,452,618,651**;21-MAR-94;Build 9
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; Reference to $$CLAIM^BPSBUTL supported by DBIA# 4719
- REPORT ;
- N IBQUIT,IBPAGE,IBNOW,IBLINE,IBLINE2,IBCRT,IBBOT,DFN,IBNAME,IBN
- S IBCRT=0,IBBOT=7,IBQUIT=0 I $E(IOST,1,2)="C-" S IBCRT=1,IBBOT=7
- S IBLINE="",$P(IBLINE,"=",86)="||",IBLINE=IBLINE_$E(IBLINE,1,45)
- S IBLINE2="",$P(IBLINE2,"-",75)="--"
- D NOW^%DTC S Y=X X ^DD("DD") S IBNOW=Y
- I IBCRT W @IOF
- LOOP ;
- S IBPAGE=1 D HEADER Q:IBQUIT
- S IBNAME="" F S IBNAME=$O(^TMP($J,"HOLD",IBNAME)) Q:IBNAME=""!(IBQUIT) S DFN=0 F S DFN=$O(^TMP($J,"HOLD",IBNAME,DFN)) Q:'DFN!(IBQUIT) D
- .D PRNTPAT,PRNTINS W:IBII ?35,IBLINE2,! Q:IBQUIT S IBN=0 F S IBN=$O(^TMP($J,"HOLD",IBNAME,DFN,IBN)) Q:'IBN!(IBQUIT) D
- ..D PRNTCHG,PRNTBILL:'IBQUIT
- Q
- PRNTBILL ; prints bills for a charge
- N IB,IB0,IBSTAT,IBCHG,IBPD,C,Y,I,IBT
- D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
- S IB="" F I=1:1 S IB=$O(^TMP($J,"HOLD",IBNAME,DFN,IBN,IB)) W:'IB&(I<2) ?85,"||",! Q:'IB!(IBQUIT) D
- .W ?85,"||"
- .S IB0=$G(^DGCR(399,IB,0)) Q:IB0=""
- .W ?88,$P(IB0,"^",1) ; bill #
- .S IBSTAT=$$STA^PRCAFN(IB)
- .W:+IBSTAT>0 ?97,$E($P(IBSTAT,"^",2),1,14)
- .S IBT=$J((+^DGCR(399,IB,"U1")-$P(^("U1"),"^",2)),9,2)
- .W ?112,IBT ; total charges
- .S IBPD=$$TPR^PRCAFN(IB) S:IBPD<0 IBPD="" S IBPD=$J(IBPD,9,2) W ?123,IBPD,! D:$Y+IBBOT>IOSL HEADER
- Q
- PRNTPAT ; prints patient data
- N VAERR,VADM,IBSSN D DEM^VADPT S:'VAERR IBSSN=VA("BID") ; pt id,brief
- D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
- W IBLINE,!
- W $E(IBNAME,1,20),?22,IBSSN
- W:IBII ?35,"Insurance Co.",?53,"Subscriber ID",?71,"Group",?88,"Eff Dt",?102,"Exp Dt",!
- Q
- PRNTINS ; prints insurance information
- Q:'$D(DFN)!(IBII=0)
- N X,IBINS,IBX
- D ALL^IBCNS1(DFN,"IBINS")
- D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
- W IBLINE,!
- I '$D(IBINS) W ?35,"No Insurance Information"
- S X=0 F S X=$O(IBINS(X)) Q:'X S IBINS=IBINS(X,0) D
- .D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
- .N COV,COVD,COVFN,IBCNT,LEDT,LIM,PLN,SP,X,X1,X2,Z0 Q:'$D(IBINS)
- .W ?36,$S($D(^DIC(36,+IBINS,0)):$E($P(^(0),"^",1),1,16),1:"UNKNOWN")
- .W ?54,$E($P(IBINS,"^",2),1,16)
- .W ?72,$E($$GRP($P(IBINS,"^",18)),1,10) S PLN=$P(IBINS,"^",18)
- .W ?88,$$DAT1^IBOUTL($P(IBINS,"^",8)),?102,$$DAT1^IBOUTL($P(IBINS,"^",4))
- .I PLN="" W !,?38,"* No Group Plan Information for this Patient - Verify Insurance Info!",! Q
- .W !,?40,"Plan Coverage Effective Date Covered? Limit Comments",!
- .W ?40,"------------- -------------- -------- --------------",!
- .S LIM=0 F S LIM=$O(^IBE(355.31,LIM)) Q:'LIM S COV=$P($G(^(LIM,0)),U),IBCNT=0,LEDT="" F S LEDT=$O(^IBA(355.32,"APCD",PLN,LIM,LEDT)) Q:$S(LEDT="":IBCNT,1:0) D Q:LEDT=""
- ..D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
- ..S COVFN=+$O(^IBA(355.32,"APCD",PLN,LIM,+LEDT,"")),COVD=$G(^IBA(355.32,+COVFN,0))
- ..I COVD="" W ?40,COV,?86,"BY DEFAULT",! Q
- ..S IBCNT=IBCNT+1
- ..S X1=" "_$S(IBCNT=1:COV,1:"") ;Don't duplicate category
- ..S X2=$$PR(X1,18)_$$PR($$DAT1^IBOUTL($P(LEDT,"-",2)),16)_$$PR($S($P(COVD,U,4):$S($P(COVD,U,4)<2:"YES",$P(COVD,U,4)=2:"CONDITIONAL",1:"UNKNOWN"),1:"NO"),14)
- ..I '$O(^IBA(355.32,COVFN,2,0)) W ?40,X2,! Q
- ..S Z0=0 F S Z0=$O(^IBA(355.32,COVFN,2,Z0)) Q:'Z0 S SP="" W ?40,$S(Z0=1:X2_$G(^IBA(355.32,COVFN,2,Z0,0)),1:$$PR(SP,48)_$G(^IBA(355.32,COVFN,2,Z0,0))),!
- Q
- GRP(IBCPOL) ; get group name/group policy
- N X,Y S X=""
- S X=$G(^IBA(355.3,+$G(IBCPOL),0))
- S Y=$S($P(X,"^",4)'="":$P(X,"^",4),1:$P(X,"^",3))
- I $P(X,"^",10) S Y="Ind Plan "_Y
- GRPQ Q Y
- PR(STR,LEN) ; pad right
- N B S STR=$E(STR,1,LEN),$P(B," ",LEN-$L(STR))=" "
- Q STR_$G(B)
- PRNTCHG ; prints a charge
- N IBACT,IBTYPE,IBBILL,IBFR,IBTO,IBCHG,IBND,IBND1
- N IBRX,IBRXN,IBRF,IBRDT,IBX,IENS,IBECME
- S IBND=$G(^IB(IBN,0))
- S IBND1=$G(^IB(IBN,1))
- S (IBRX,IBRXN,IBRF,IBRDT,IBX,IBECME)=0
- ; action id
- S IBACT=+IBND
- ; type
- ; begin of Patch IB*2.0*618 - added community care - action types to HELD CHARGES report
- S IBTYPE=$P(IBND,"^",3),IBTYPE=$P($G(^IBE(350.1,IBTYPE,0)),"^",1)
- S IBTYPE=$$IBACTYPE(IBTYPE)
- ; end of Patch IB*2.0*618
- ; bill #
- S IBBILL=$P($P(IBND,"^",11),"-",2)
- ; rx info
- I $P(IBND,"^",4)["52:" D
- . S IBRXN=+$P($P(IBND,"^",4),":",2) ; Rx ien
- . S IBRX=$P($P(IBND,"^",8),"-") ; external Rx#
- . S IBRF=+$P($P(IBND,"^",4),":",3) ; fill# or 0 for original fill
- . S IBECME=$P($$CLAIM^BPSBUTL(IBRXN,IBRF),U,6) ; ecme# DBIA# 4719
- . I IBRF S IENS=+IBRF,IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,+IENS,52,.01) ; refill date
- . I 'IBRF S IENS=+IBRXN,IBRDT=$$FILE^IBRXUTL(+IENS,22) ; orig fill date
- . Q
- ;
- S IBX=$$APPT^IBCU3(IBRDT,DFN)
- ; from/rx fill date
- S IBFR=$$DAT1^IBOUTL($S(IBRXN>0:IBRDT,1:$P(IBND,"^",15)))
- ; to date
- S IBTO=$$DAT1^IBOUTL($S($P(IBND,"^",15)'="":($P(IBND,"^",15)),1:$P(IBND1,"^",2)))
- ; charge$
- S IBCHG=$J(+$P(IBND,"^",7),9,2)
- W ?29,IBACT,?39,IBTYPE,?46,IBBILL
- I IBRX>0 W ?55,"Rx #: "_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),?85,"||",! I IBECME W ?55,"ECME #: ",IBECME,?85,"||",!
- W:IBX=1 ?54,"*"
- W ?55,IBFR,?66,IBTO,?75,IBCHG
- Q
- Q:IBQUIT
- I IBCRT,$Y>1 D Q:IBQUIT ;F Q:$Y>(IOSL-1) W !
- .W ! N T R " Press RETURN to continue",T:DTIME I '$T!(T["^") S IBQUIT=1 Q
- I IBPAGE>1 W !,@IOF
- W ?53,"MEANS TEST CHARGES ON HOLD",?110,IBNOW," PAGE ",IBPAGE,!,"HELD CHARGES",?87,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
- W !,"Name",?22,"Pt.ID",?29,"Act.ID",?39,"Type",?46,"Bill#",?55,"Fr/Fl Dt",?66,"To/Rls Dt",?78,"Charge",?85,"||",?88,"Bill#",?97,"AR-Status",?115,"Charge",?128,"Paid"
- W !,IBLINE,!
- W ?20,"'*' = outpt visit on same day as Rx fill date",?85,"||",!,IBLINE,!
- S IBPAGE=IBPAGE+1
- Q
- IBACTYPE(IBTYPE) ; Patch IB*2.0*618 - added community care - action types to HELD CHARGES report
- I IBTYPE["URGENT " Q "NVCUC"
- I IBTYPE["CC " Q "NVC"
- I IBTYPE["CCN " Q "NVC"
- I IBTYPE["CHOICE" Q "NVC"
- I IBTYPE["PSO NSC" Q "RXNSC"
- I IBTYPE["PSO SC" Q "RX SC"
- Q $E(IBTYPE,4,7)
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOHLD2 6031 printed Feb 18, 2025@23:52:07 Page 2
- IBOHLD2 ;ALB/CJM - REPORT OF CHARGES ON HOLD W/INS ;MAR 6,1991
- +1 ;;2.0;INTEGRATED BILLING;**70,95,133,153,347,452,618,651**;21-MAR-94;Build 9
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; Reference to $$CLAIM^BPSBUTL supported by DBIA# 4719
- REPORT ;
- +1 NEW IBQUIT,IBPAGE,IBNOW,IBLINE,IBLINE2,IBCRT,IBBOT,DFN,IBNAME,IBN
- +2 SET IBCRT=0
- SET IBBOT=7
- SET IBQUIT=0
- IF $EXTRACT(IOST,1,2)="C-"
- SET IBCRT=1
- SET IBBOT=7
- +3 SET IBLINE=""
- SET $PIECE(IBLINE,"=",86)="||"
- SET IBLINE=IBLINE_$EXTRACT(IBLINE,1,45)
- +4 SET IBLINE2=""
- SET $PIECE(IBLINE2,"-",75)="--"
- +5 DO NOW^%DTC
- SET Y=X
- XECUTE ^DD("DD")
- SET IBNOW=Y
- +6 IF IBCRT
- WRITE @IOF
- LOOP ;
- +1 SET IBPAGE=1
- DO HEADER
- if IBQUIT
- QUIT
- +2 SET IBNAME=""
- FOR
- SET IBNAME=$ORDER(^TMP($JOB,"HOLD",IBNAME))
- if IBNAME=""!(IBQUIT)
- QUIT
- SET DFN=0
- FOR
- SET DFN=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN))
- if 'DFN!(IBQUIT)
- QUIT
- Begin DoDot:1
- +3 DO PRNTPAT
- DO PRNTINS
- if IBII
- WRITE ?35,IBLINE2,!
- if IBQUIT
- QUIT
- SET IBN=0
- FOR
- SET IBN=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN,IBN))
- if 'IBN!(IBQUIT)
- QUIT
- Begin DoDot:2
- +4 DO PRNTCHG
- if 'IBQUIT
- DO PRNTBILL
- End DoDot:2
- End DoDot:1
- +5 QUIT
- PRNTBILL ; prints bills for a charge
- +1 NEW IB,IB0,IBSTAT,IBCHG,IBPD,C,Y,I,IBT
- +2 if $Y+IBBOT>IOSL
- DO HEADER
- if IBQUIT
- QUIT
- +3 SET IB=""
- FOR I=1:1
- SET IB=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN,IBN,IB))
- if 'IB&(I<2)
- WRITE ?85,"||",!
- if 'IB!(IBQUIT)
- QUIT
- Begin DoDot:1
- +4 WRITE ?85,"||"
- +5 SET IB0=$GET(^DGCR(399,IB,0))
- if IB0=""
- QUIT
- +6 ; bill #
- WRITE ?88,$PIECE(IB0,"^",1)
- +7 SET IBSTAT=$$STA^PRCAFN(IB)
- +8 if +IBSTAT>0
- WRITE ?97,$EXTRACT($PIECE(IBSTAT,"^",2),1,14)
- +9 SET IBT=$JUSTIFY((+^DGCR(399,IB,"U1")-$PIECE(^("U1"),"^",2)),9,2)
- +10 ; total charges
- WRITE ?112,IBT
- +11 SET IBPD=$$TPR^PRCAFN(IB)
- if IBPD<0
- SET IBPD=""
- SET IBPD=$JUSTIFY(IBPD,9,2)
- WRITE ?123,IBPD,!
- if $Y+IBBOT>IOSL
- DO HEADER
- End DoDot:1
- +12 QUIT
- PRNTPAT ; prints patient data
- +1 ; pt id,brief
- NEW VAERR,VADM,IBSSN
- DO DEM^VADPT
- if 'VAERR
- SET IBSSN=VA("BID")
- +2 if $Y+IBBOT>IOSL
- DO HEADER
- if IBQUIT
- QUIT
- +3 WRITE IBLINE,!
- +4 WRITE $EXTRACT(IBNAME,1,20),?22,IBSSN
- +5 if IBII
- WRITE ?35,"Insurance Co.",?53,"Subscriber ID",?71,"Group",?88,"Eff Dt",?102,"Exp Dt",!
- +6 QUIT
- PRNTINS ; prints insurance information
- +1 if '$DATA(DFN)!(IBII=0)
- QUIT
- +2 NEW X,IBINS,IBX
- +3 DO ALL^IBCNS1(DFN,"IBINS")
- +4 if $Y+IBBOT>IOSL
- DO HEADER
- if IBQUIT
- QUIT
- +5 WRITE IBLINE,!
- +6 IF '$DATA(IBINS)
- WRITE ?35,"No Insurance Information"
- +7 SET X=0
- FOR
- SET X=$ORDER(IBINS(X))
- if 'X
- QUIT
- SET IBINS=IBINS(X,0)
- Begin DoDot:1
- +8 if $Y+IBBOT>IOSL
- DO HEADER
- if IBQUIT
- QUIT
- +9 NEW COV,COVD,COVFN,IBCNT,LEDT,LIM,PLN,SP,X,X1,X2,Z0
- if '$DATA(IBINS)
- QUIT
- +10 WRITE ?36,$SELECT($DATA(^DIC(36,+IBINS,0)):$EXTRACT($PIECE(^(0),"^",1),1,16),1:"UNKNOWN")
- +11 WRITE ?54,$EXTRACT($PIECE(IBINS,"^",2),1,16)
- +12 WRITE ?72,$EXTRACT($$GRP($PIECE(IBINS,"^",18)),1,10)
- SET PLN=$PIECE(IBINS,"^",18)
- +13 WRITE ?88,$$DAT1^IBOUTL($PIECE(IBINS,"^",8)),?102,$$DAT1^IBOUTL($PIECE(IBINS,"^",4))
- +14 IF PLN=""
- WRITE !,?38,"* No Group Plan Information for this Patient - Verify Insurance Info!",!
- QUIT
- +15 WRITE !,?40,"Plan Coverage Effective Date Covered? Limit Comments",!
- +16 WRITE ?40,"------------- -------------- -------- --------------",!
- +17 SET LIM=0
- FOR
- SET LIM=$ORDER(^IBE(355.31,LIM))
- if 'LIM
- QUIT
- SET COV=$PIECE($GET(^(LIM,0)),U)
- SET IBCNT=0
- SET LEDT=""
- FOR
- SET LEDT=$ORDER(^IBA(355.32,"APCD",PLN,LIM,LEDT))
- if $SELECT(LEDT=""
- QUIT
- Begin DoDot:2
- +18 if $Y+IBBOT>IOSL
- DO HEADER
- if IBQUIT
- QUIT
- +19 SET COVFN=+$ORDER(^IBA(355.32,"APCD",PLN,LIM,+LEDT,""))
- SET COVD=$GET(^IBA(355.32,+COVFN,0))
- +20 IF COVD=""
- WRITE ?40,COV,?86,"BY DEFAULT",!
- QUIT
- +21 SET IBCNT=IBCNT+1
- +22 ;Don't duplicate category
- SET X1=" "_$SELECT(IBCNT=1:COV,1:"")
- +23 SET X2=$$PR(X1,18)_$$PR($$DAT1^IBOUTL($PIECE(LEDT,"-",2)),16)_$$PR($SELECT($PIECE(COVD,U,4):$SELECT($PIECE(COVD,U,4)<2:"YES",$PIECE(COVD,U,4)=2:"CONDITIONAL",1:"UNKNOWN"),1:"NO"),14)
- +24 IF '$ORDER(^IBA(355.32,COVFN,2,0))
- WRITE ?40,X2,!
- QUIT
- +25 SET Z0=0
- FOR
- SET Z0=$ORDER(^IBA(355.32,COVFN,2,Z0))
- if 'Z0
- QUIT
- SET SP=""
- WRITE ?40,$SELECT(Z0=1:X2_$GET(^IBA(355.32,COVFN,2,Z0,0)),1:$$PR(SP,48)_$GET(^IBA(355.32,COVFN,2,Z0,0))),!
- End DoDot:2
- if LEDT=""
- QUIT
- End DoDot:1
- +26 QUIT
- GRP(IBCPOL) ; get group name/group policy
- +1 NEW X,Y
- SET X=""
- +2 SET X=$GET(^IBA(355.3,+$GET(IBCPOL),0))
- +3 SET Y=$SELECT($PIECE(X,"^",4)'="":$PIECE(X,"^",4),1:$PIECE(X,"^",3))
- +4 IF $PIECE(X,"^",10)
- SET Y="Ind Plan "_Y
- GRPQ QUIT Y
- PR(STR,LEN) ; pad right
- +1 NEW B
- SET STR=$EXTRACT(STR,1,LEN)
- SET $PIECE(B," ",LEN-$LENGTH(STR))=" "
- +2 QUIT STR_$GET(B)
- PRNTCHG ; prints a charge
- +1 NEW IBACT,IBTYPE,IBBILL,IBFR,IBTO,IBCHG,IBND,IBND1
- +2 NEW IBRX,IBRXN,IBRF,IBRDT,IBX,IENS,IBECME
- +3 SET IBND=$GET(^IB(IBN,0))
- +4 SET IBND1=$GET(^IB(IBN,1))
- +5 SET (IBRX,IBRXN,IBRF,IBRDT,IBX,IBECME)=0
- +6 ; action id
- +7 SET IBACT=+IBND
- +8 ; type
- +9 ; begin of Patch IB*2.0*618 - added community care - action types to HELD CHARGES report
- +10 SET IBTYPE=$PIECE(IBND,"^",3)
- SET IBTYPE=$PIECE($GET(^IBE(350.1,IBTYPE,0)),"^",1)
- +11 SET IBTYPE=$$IBACTYPE(IBTYPE)
- +12 ; end of Patch IB*2.0*618
- +13 ; bill #
- +14 SET IBBILL=$PIECE($PIECE(IBND,"^",11),"-",2)
- +15 ; rx info
- +16 IF $PIECE(IBND,"^",4)["52:"
- Begin DoDot:1
- +17 ; Rx ien
- SET IBRXN=+$PIECE($PIECE(IBND,"^",4),":",2)
- +18 ; external Rx#
- SET IBRX=$PIECE($PIECE(IBND,"^",8),"-")
- +19 ; fill# or 0 for original fill
- SET IBRF=+$PIECE($PIECE(IBND,"^",4),":",3)
- +20 ; ecme# DBIA# 4719
- SET IBECME=$PIECE($$CLAIM^BPSBUTL(IBRXN,IBRF),U,6)
- +21 ; refill date
- IF IBRF
- SET IENS=+IBRF
- SET IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,+IENS,52,.01)
- +22 ; orig fill date
- IF 'IBRF
- SET IENS=+IBRXN
- SET IBRDT=$$FILE^IBRXUTL(+IENS,22)
- +23 QUIT
- End DoDot:1
- +24 ;
- +25 SET IBX=$$APPT^IBCU3(IBRDT,DFN)
- +26 ; from/rx fill date
- +27 SET IBFR=$$DAT1^IBOUTL($SELECT(IBRXN>0:IBRDT,1:$PIECE(IBND,"^",15)))
- +28 ; to date
- +29 SET IBTO=$$DAT1^IBOUTL($SELECT($PIECE(IBND,"^",15)'="":($PIECE(IBND,"^",15)),1:$PIECE(IBND1,"^",2)))
- +30 ; charge$
- +31 SET IBCHG=$JUSTIFY(+$PIECE(IBND,"^",7),9,2)
- +32 WRITE ?29,IBACT,?39,IBTYPE,?46,IBBILL
- +33 IF IBRX>0
- WRITE ?55,"Rx #: "_IBRX_$SELECT(IBRF>0:"("_IBRF_")",1:""),?85,"||",!
- IF IBECME
- WRITE ?55,"ECME #: ",IBECME,?85,"||",!
- +34 if IBX=1
- WRITE ?54,"*"
- +35 WRITE ?55,IBFR,?66,IBTO,?75,IBCHG
- +36 QUIT
- +1 if IBQUIT
- QUIT
- +2 ;F Q:$Y>(IOSL-1) W !
- IF IBCRT
- IF $Y>1
- Begin DoDot:1
- +3 WRITE !
- NEW T
- READ " Press RETURN to continue",T:DTIME
- IF '$TEST!(T["^")
- SET IBQUIT=1
- QUIT
- End DoDot:1
- if IBQUIT
- QUIT
- +4 IF IBPAGE>1
- WRITE !,@IOF
- +5 WRITE ?53,"MEANS TEST CHARGES ON HOLD",?110,IBNOW," PAGE ",IBPAGE,!,"HELD CHARGES",?87,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
- +6 WRITE !,"Name",?22,"Pt.ID",?29,"Act.ID",?39,"Type",?46,"Bill#",?55,"Fr/Fl Dt",?66,"To/Rls Dt",?78,"Charge",?85,"||",?88,"Bill#",?97,"AR-Status",?115,"Charge",?128,"Paid"
- +7 WRITE !,IBLINE,!
- +8 WRITE ?20,"'*' = outpt visit on same day as Rx fill date",?85,"||",!,IBLINE,!
- +9 SET IBPAGE=IBPAGE+1
- +10 QUIT
- IBACTYPE(IBTYPE) ; Patch IB*2.0*618 - added community care - action types to HELD CHARGES report
- +1 IF IBTYPE["URGENT "
- QUIT "NVCUC"
- +2 IF IBTYPE["CC "
- QUIT "NVC"
- +3 IF IBTYPE["CCN "
- QUIT "NVC"
- +4 IF IBTYPE["CHOICE"
- QUIT "NVC"
- +5 IF IBTYPE["PSO NSC"
- QUIT "RXNSC"
- +6 IF IBTYPE["PSO SC"
- QUIT "RX SC"
- +7 QUIT $EXTRACT(IBTYPE,4,7)
- +8 ;