IBCNRP ;DAOU/ALA - Plan Match ListMan ;13-NOV-2003
;;2.0;INTEGRATED BILLING;**251,516,550,617**;21-MAR-94;Build 43
;;Per VA Directive 6402, this routine should not be modified.
;; ;
EN ; -- main entry point for IBCNR PLAN MATCH
D EN^VALM("IBCNR PLAN MATCH")
Q
;
HDR ; -- header code
NEW IBCNS0,IBCNS11,IBCNS13,IBLEAD,X,X1,X2
S IBCNS0=$G(^DIC(36,+IBCNSP,0))
S IBCNS11=$G(^DIC(36,+IBCNSP,.11))
S IBCNS13=$G(^DIC(36,+IBCNSP,.13))
S X2=$S(IBW:"",1:"Active ")
S IBLEAD=$S(IBIND:"All "_X2,1:X2_"Group ")_"Plans for: "
S X="Phone: "_$S($P(IBCNS13,"^")]"":$P(IBCNS13,"^"),1:"<not filed>")
S VALMHDR(1)=$$SETSTR^VALM1(X,IBLEAD_$P(IBCNS0,"^"),81-$L(X),40)
S X1="Precerts: "_$S($P(IBCNS13,"^",3)]"":$P(IBCNS13,"^",3),1:"<not filed>")
S X=$TR($J("",$L(IBLEAD)),""," ")_$S($P(IBCNS11,"^")]"":$P(IBCNS11,"^"),1:"<no street address>")
S VALMHDR(2)=$$SETSTR^VALM1(X1,X,81-$L(X1),40)
S X=$S($P(IBCNS11,"^",4)]"":$P(IBCNS11,"^",4),1:"<no city>")_", "
S X=X_$S($P(IBCNS11,"^",5):$P($G(^DIC(5,$P(IBCNS11,"^",5),0)),"^",2),1:"<no state>")_" "_$E($P(IBCNS11,"^",6),1,5)_$S($E($P(IBCNS11,"^",6),6,9)]"":"-"_$E($P(IBCNS11,"^",6),6,9),1:"")
S VALMHDR(3)=$$SETSTR^VALM1(X,"",$L(IBLEAD)+1,80)
S X="#" I $G(IBIND) S X="# + => Indiv. Plan"
I $G(IBW) S X=$E(X_$J("",23),1,23)_"* => Inactive Plan"
S VALMHDR(4)=$$SETSTR^VALM1(" ",X,64,17)
Q
;
INIT ; -- init variables and list array
NEW IBCNRPP,IBCOV,IBCPD6,IBCPOLD,IBCRVD,IBMDTE,IBMUSR,LIM,X
K ^TMP("IBCNR",$J)
S VALMCNT=0,VALMBG=1
S VALMCNT1=0
; MRD;IB*2.0*516 - Rather than pull the zero node here, use $$GET1^DIQ
; to pull specific pieces down below.
;S IBGP0=^IBA(355.3,+IBCNGP,0)
;I $G(IBGP0) D
I $G(^IBA(355.3,+IBCNGP,0)) D
. ;S IBCPD6=$G(IBGP0,U,6)) ;chk pre-cert
. ;I 'IBIND,'$P(IBGP0,"^",2) Q ; exclude individual plans
. ;I 'IBW,$P(IBGP0,"^",11) Q ; plan is inactive
. ;
. S VALMCNT=VALMCNT+1
. S VALMCNT1=VALMCNT1+1
. S X=$$SETFLD^VALM1(VALMCNT1,"","NUMBER")
. ;
. ;I '$P(IBGP0,"^",2) S $E(X,4)="+"
. ;S X=$$SETFLD^VALM1($P(IBGP0,"^",3),X,"GNAME")
. I '$$GET1^DIQ(355.3,+IBCNGP_",",.02,"I") S $E(X,4)="+"
. S X=$$SETFLD^VALM1($$GET1^DIQ(355.3,+IBCNGP_",",2.01),X,"GNAME")
. ;
. ;I $P(IBGP0,"^",11) S $E(X,24)="*"
. ;S X=$$SETFLD^VALM1($P(IBGP0,"^",4),X,"GNUM")
. I $$GET1^DIQ(355.3,+IBCNGP_",",.11,"I") S $E(X,24)="*"
. S X=$$SETFLD^VALM1($$GET1^DIQ(355.3,+IBCNGP_",",2.02),X,"GNUM")
. ;
. ;S X=$$SETFLD^VALM1($$EXPAND^IBTRE(355.3,.09,$P(IBGP0,"^",9)),X,"TYPE")
. S X=$$SETFLD^VALM1($$GET1^DIQ(355.3,+IBCNGP_",",.09,"E"),X,"TYPE")
. ;
. S IBCNRPP=$$GET1^DIQ(355.3,IBCNGP_",",6.01,"I")
. I IBCNRPP'="" S IBCNRPP=$$GET1^DIQ(366.03,IBCNRPP_",",.01,"E")
. S X=$$SETFLD^VALM1(IBCNRPP,X,"PHARM")
. ;
. S IBCOV=$O(^IBE(355.31,"B","PHARMACY",""))
. S LIM="",IBCVRD=0
. F S LIM=$O(^IBA(355.32,"B",IBCNGP,LIM)) Q:LIM="" D
.. I $P(^IBA(355.32,LIM,0),U,2)=IBCOV S IBCVRD=$P(^IBA(355.32,LIM,0),U,4)
. S X=$$SETFLD^VALM1($S(IBCVRD=0:"NO",1:"YES"),X,"COV")
. ;
. S ^TMP("IBCNR",$J,VALMCNT,0)=X
. S ^TMP("IBCNR",$J,"IDX",VALMCNT,VALMCNT1)=IBCNGP
. S ^TMP("IBCNR",$J,"IDX1",VALMCNT1)=IBCNGP
. ;
. I IBCNRPP'="" D ; If VA PLAN ID exists
. . S IBMDTE=$$GET1^DIQ(355.3,IBCNGP_",",1.07,"E")
. . S IBMUSR=$$GET1^DIQ(355.3,IBCNGP_",",1.08,"E")
. . I IBMDTE'="" D ; If DATE LAST MATCHED exists
. . . S X=" Matched by: "_IBMUSR_" "_IBMDTE
. . . S VALMCNT=VALMCNT+1
. . . S ^TMP("IBCNR",$J,VALMCNT,0)=X
. . . S ^TMP("IBCNR",$J,"IDX",VALMCNT,VALMCNT1)=IBCNGP
. . . S ^TMP("IBCNR",$J,"IDX1",VALMCNT1)=IBCNGP
. I IBCNRPP="" D ; If VA PLAN ID does not exist
. . S IBMDTE=$$GET1^DIQ(355.3,IBCNGP_",",1.07,"E")
. . S IBMUSR=$$GET1^DIQ(355.3,IBCNGP_",",1.08,"E")
. . I IBMDTE'="" D ; Match Date w/no Plan ID means Deleted
. . . S X=" Deleted by: "_IBMUSR_" "_IBMDTE
. . . S VALMCNT=VALMCNT+1
. . . S ^TMP("IBCNR",$J,VALMCNT,0)=X
. . . S ^TMP("IBCNR",$J,"IDX",VALMCNT,VALMCNT1)=IBCNGP
. . . S ^TMP("IBCNR",$J,"IDX1",VALMCNT1)=IBCNGP
. ;
. I '$D(^TMP("IBCNR",$J)) S VALMCNT=2,^TMP("IBCNR",$J,1,0)=" ",^TMP("IBCNR",$J,2,0)=" No plans were identified for this company."
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBCNR",$J),VALMBCK,VALMY
D CLEAN^VALM10,CLEAR^VALM1
Q
;
EXPND ; -- expand code
Q
;
SEL ; -- select plan
D S1
I 'IBX Q ; no group selected
;
NEW DA,DIC,DIE,DR,D,IBPLN,IBPLNOLD,IBUSROLD
S DIC="^IBCNR(366.03,",DIC(0)="AEMNZ" D ^DIC
I +Y<1 S D="F" D IX^DIC
I +Y<1 G SPQ
S IBPLN=+Y K Y,X
D PLCK ; check plan status
S IBPLNOLD=$$GET1^DIQ(355.3,IBCNGP,6.01,"I")
S IBUSROLD=$$GET1^DIQ(355.3,IBCNGP,1.08)
S DA=IBSEL,DIC="^IBA(355.3,",DIE=DIC,DR="6.01////^S X="_IBPLN
I IBPLNOLD'=IBPLN S DR=DR_";1.07///NOW;1.08////"_DUZ
I IBPLNOLD=IBPLN,IBUSROLD="" S DR=DR_";1.07///NOW;1.08////"_DUZ
D ^DIE
D INIT
;
S IBX=0 F S IBX=$O(VALMY(IBX)) Q:'IBX S ^TMP($J,"IBSEL",+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX)))=""
;
D SPQ
Q
;
PLCK ; -- check plan status
NEW ARRAY
D STCHK^IBCNRU1(IBPLN,.ARRAY)
I $G(ARRAY(1))'="A" D
. W !!,"WARNING....PLAN NOT ACTIVE!"
;
Q
;
DEL ; -- remove a plan from a group
D S1
;
NEW DA,DIC,DIE,DR,IBPLNOLD
S IBPLNOLD=$$GET1^DIQ(355.3,IBCNGP,6.01,"I")
S DA=IBSEL,DIC="^IBA(355.3,",DIE=DIC,DR="6.01///@"
I IBPLNOLD'="" S DR=DR_";1.07///NOW;1.08////"_DUZ
D ^DIE
D INIT
;
S IBX=0 F S IBX=$O(VALMY(IBX)) Q:'IBX S ^TMP($J,"IBSEL",+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX)))=""
;
D SPQ
Q
;
S1 ;
NEW DIR,DIRUT,DUOUT,DTOUT,DIROUT,IBOK,IBQUIT,Y
D EN^VALM2($G(XQORNOD(0)),"S"),FULL^VALM1
S IBX=$O(VALMY(0)),VALMBCK="R"
;
I 'IBX W !!,"No group selected!" G SPQ
I 'IBMULT D G SPQ
. I $O(VALMY(IBX)) W !!,*7,"You may only select a single plan!" Q
. I $G(IBALR),+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX))=IBALR W !!,*7,"This plan is not allowed for selection!" Q
. D OK^IBCNSM3
. I IBQUIT S VALMBCK="Q" Q
. ;I IBOK S IBSEL=+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX)),VALMBCK="Q"
. I IBOK S IBSEL=+$G(^TMP("IBCNR",$J,"IDX1",IBX)),VALMBCK="Q"
;
;S IBSEL=+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX))
S IBSEL=+$G(^TMP("IBCNR",$J,"IDX1",IBX))
Q
;
SPQ ;
I '$O(IBSEL(0)),VALMBCK="R" D PAUSE^VALM1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRP 6278 printed Apr 09, 2024@21:03:36 Page 2
IBCNRP ;DAOU/ALA - Plan Match ListMan ;13-NOV-2003
+1 ;;2.0;INTEGRATED BILLING;**251,516,550,617**;21-MAR-94;Build 43
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;; ;
EN ; -- main entry point for IBCNR PLAN MATCH
+1 DO EN^VALM("IBCNR PLAN MATCH")
+2 QUIT
+3 ;
HDR ; -- header code
+1 NEW IBCNS0,IBCNS11,IBCNS13,IBLEAD,X,X1,X2
+2 SET IBCNS0=$GET(^DIC(36,+IBCNSP,0))
+3 SET IBCNS11=$GET(^DIC(36,+IBCNSP,.11))
+4 SET IBCNS13=$GET(^DIC(36,+IBCNSP,.13))
+5 SET X2=$SELECT(IBW:"",1:"Active ")
+6 SET IBLEAD=$SELECT(IBIND:"All "_X2,1:X2_"Group ")_"Plans for: "
+7 SET X="Phone: "_$SELECT($PIECE(IBCNS13,"^")]"":$PIECE(IBCNS13,"^"),1:"<not filed>")
+8 SET VALMHDR(1)=$$SETSTR^VALM1(X,IBLEAD_$PIECE(IBCNS0,"^"),81-$LENGTH(X),40)
+9 SET X1="Precerts: "_$SELECT($PIECE(IBCNS13,"^",3)]"":$PIECE(IBCNS13,"^",3),1:"<not filed>")
+10 SET X=$TRANSLATE($JUSTIFY("",$LENGTH(IBLEAD)),""," ")_$SELECT($PIECE(IBCNS11,"^")]"":$PIECE(IBCNS11,"^"),1:"<no street address>")
+11 SET VALMHDR(2)=$$SETSTR^VALM1(X1,X,81-$LENGTH(X1),40)
+12 SET X=$SELECT($PIECE(IBCNS11,"^",4)]"":$PIECE(IBCNS11,"^",4),1:"<no city>")_", "
+13 SET X=X_$SELECT($PIECE(IBCNS11,"^",5):$PIECE($GET(^DIC(5,$PIECE(IBCNS11,"^",5),0)),"^",2),1:"<no state>")_" "_$EXTRACT($PIECE(IBCNS11,"^",6),1,5)_$SELECT($EXTRACT($PIECE(IBCNS11,"^",6),6,9)]"":"-"_$EXTRACT($PIECE(IBCNS11,"^",6),6,9),1:"")
+14 SET VALMHDR(3)=$$SETSTR^VALM1(X,"",$LENGTH(IBLEAD)+1,80)
+15 SET X="#"
IF $GET(IBIND)
SET X="# + => Indiv. Plan"
+16 IF $GET(IBW)
SET X=$EXTRACT(X_$JUSTIFY("",23),1,23)_"* => Inactive Plan"
+17 SET VALMHDR(4)=$$SETSTR^VALM1(" ",X,64,17)
+18 QUIT
+19 ;
INIT ; -- init variables and list array
+1 NEW IBCNRPP,IBCOV,IBCPD6,IBCPOLD,IBCRVD,IBMDTE,IBMUSR,LIM,X
+2 KILL ^TMP("IBCNR",$JOB)
+3 SET VALMCNT=0
SET VALMBG=1
+4 SET VALMCNT1=0
+5 ; MRD;IB*2.0*516 - Rather than pull the zero node here, use $$GET1^DIQ
+6 ; to pull specific pieces down below.
+7 ;S IBGP0=^IBA(355.3,+IBCNGP,0)
+8 ;I $G(IBGP0) D
+9 IF $GET(^IBA(355.3,+IBCNGP,0))
Begin DoDot:1
+10 ;S IBCPD6=$G(IBGP0,U,6)) ;chk pre-cert
+11 ;I 'IBIND,'$P(IBGP0,"^",2) Q ; exclude individual plans
+12 ;I 'IBW,$P(IBGP0,"^",11) Q ; plan is inactive
+13 ;
+14 SET VALMCNT=VALMCNT+1
+15 SET VALMCNT1=VALMCNT1+1
+16 SET X=$$SETFLD^VALM1(VALMCNT1,"","NUMBER")
+17 ;
+18 ;I '$P(IBGP0,"^",2) S $E(X,4)="+"
+19 ;S X=$$SETFLD^VALM1($P(IBGP0,"^",3),X,"GNAME")
+20 IF '$$GET1^DIQ(355.3,+IBCNGP_",",.02,"I")
SET $EXTRACT(X,4)="+"
+21 SET X=$$SETFLD^VALM1($$GET1^DIQ(355.3,+IBCNGP_",",2.01),X,"GNAME")
+22 ;
+23 ;I $P(IBGP0,"^",11) S $E(X,24)="*"
+24 ;S X=$$SETFLD^VALM1($P(IBGP0,"^",4),X,"GNUM")
+25 IF $$GET1^DIQ(355.3,+IBCNGP_",",.11,"I")
SET $EXTRACT(X,24)="*"
+26 SET X=$$SETFLD^VALM1($$GET1^DIQ(355.3,+IBCNGP_",",2.02),X,"GNUM")
+27 ;
+28 ;S X=$$SETFLD^VALM1($$EXPAND^IBTRE(355.3,.09,$P(IBGP0,"^",9)),X,"TYPE")
+29 SET X=$$SETFLD^VALM1($$GET1^DIQ(355.3,+IBCNGP_",",.09,"E"),X,"TYPE")
+30 ;
+31 SET IBCNRPP=$$GET1^DIQ(355.3,IBCNGP_",",6.01,"I")
+32 IF IBCNRPP'=""
SET IBCNRPP=$$GET1^DIQ(366.03,IBCNRPP_",",.01,"E")
+33 SET X=$$SETFLD^VALM1(IBCNRPP,X,"PHARM")
+34 ;
+35 SET IBCOV=$ORDER(^IBE(355.31,"B","PHARMACY",""))
+36 SET LIM=""
SET IBCVRD=0
+37 FOR
SET LIM=$ORDER(^IBA(355.32,"B",IBCNGP,LIM))
if LIM=""
QUIT
Begin DoDot:2
+38 IF $PIECE(^IBA(355.32,LIM,0),U,2)=IBCOV
SET IBCVRD=$PIECE(^IBA(355.32,LIM,0),U,4)
End DoDot:2
+39 SET X=$$SETFLD^VALM1($SELECT(IBCVRD=0:"NO",1:"YES"),X,"COV")
+40 ;
+41 SET ^TMP("IBCNR",$JOB,VALMCNT,0)=X
+42 SET ^TMP("IBCNR",$JOB,"IDX",VALMCNT,VALMCNT1)=IBCNGP
+43 SET ^TMP("IBCNR",$JOB,"IDX1",VALMCNT1)=IBCNGP
+44 ;
+45 ; If VA PLAN ID exists
IF IBCNRPP'=""
Begin DoDot:2
+46 SET IBMDTE=$$GET1^DIQ(355.3,IBCNGP_",",1.07,"E")
+47 SET IBMUSR=$$GET1^DIQ(355.3,IBCNGP_",",1.08,"E")
+48 ; If DATE LAST MATCHED exists
IF IBMDTE'=""
Begin DoDot:3
+49 SET X=" Matched by: "_IBMUSR_" "_IBMDTE
+50 SET VALMCNT=VALMCNT+1
+51 SET ^TMP("IBCNR",$JOB,VALMCNT,0)=X
+52 SET ^TMP("IBCNR",$JOB,"IDX",VALMCNT,VALMCNT1)=IBCNGP
+53 SET ^TMP("IBCNR",$JOB,"IDX1",VALMCNT1)=IBCNGP
End DoDot:3
End DoDot:2
+54 ; If VA PLAN ID does not exist
IF IBCNRPP=""
Begin DoDot:2
+55 SET IBMDTE=$$GET1^DIQ(355.3,IBCNGP_",",1.07,"E")
+56 SET IBMUSR=$$GET1^DIQ(355.3,IBCNGP_",",1.08,"E")
+57 ; Match Date w/no Plan ID means Deleted
IF IBMDTE'=""
Begin DoDot:3
+58 SET X=" Deleted by: "_IBMUSR_" "_IBMDTE
+59 SET VALMCNT=VALMCNT+1
+60 SET ^TMP("IBCNR",$JOB,VALMCNT,0)=X
+61 SET ^TMP("IBCNR",$JOB,"IDX",VALMCNT,VALMCNT1)=IBCNGP
+62 SET ^TMP("IBCNR",$JOB,"IDX1",VALMCNT1)=IBCNGP
End DoDot:3
End DoDot:2
+63 ;
+64 IF '$DATA(^TMP("IBCNR",$JOB))
SET VALMCNT=2
SET ^TMP("IBCNR",$JOB,1,0)=" "
SET ^TMP("IBCNR",$JOB,2,0)=" No plans were identified for this company."
End DoDot:1
+65 QUIT
+66 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBCNR",$JOB),VALMBCK,VALMY
+2 DO CLEAN^VALM10
DO CLEAR^VALM1
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
SEL ; -- select plan
+1 DO S1
+2 ; no group selected
IF 'IBX
QUIT
+3 ;
+4 NEW DA,DIC,DIE,DR,D,IBPLN,IBPLNOLD,IBUSROLD
+5 SET DIC="^IBCNR(366.03,"
SET DIC(0)="AEMNZ"
DO ^DIC
+6 IF +Y<1
SET D="F"
DO IX^DIC
+7 IF +Y<1
GOTO SPQ
+8 SET IBPLN=+Y
KILL Y,X
+9 ; check plan status
DO PLCK
+10 SET IBPLNOLD=$$GET1^DIQ(355.3,IBCNGP,6.01,"I")
+11 SET IBUSROLD=$$GET1^DIQ(355.3,IBCNGP,1.08)
+12 SET DA=IBSEL
SET DIC="^IBA(355.3,"
SET DIE=DIC
SET DR="6.01////^S X="_IBPLN
+13 IF IBPLNOLD'=IBPLN
SET DR=DR_";1.07///NOW;1.08////"_DUZ
+14 IF IBPLNOLD=IBPLN
IF IBUSROLD=""
SET DR=DR_";1.07///NOW;1.08////"_DUZ
+15 DO ^DIE
+16 DO INIT
+17 ;
+18 SET IBX=0
FOR
SET IBX=$ORDER(VALMY(IBX))
if 'IBX
QUIT
SET ^TMP($JOB,"IBSEL",+$GET(^TMP("IBCNR",$JOB,"IDX",IBX,IBX)))=""
+19 ;
+20 DO SPQ
+21 QUIT
+22 ;
PLCK ; -- check plan status
+1 NEW ARRAY
+2 DO STCHK^IBCNRU1(IBPLN,.ARRAY)
+3 IF $GET(ARRAY(1))'="A"
Begin DoDot:1
+4 WRITE !!,"WARNING....PLAN NOT ACTIVE!"
End DoDot:1
+5 ;
+6 QUIT
+7 ;
DEL ; -- remove a plan from a group
+1 DO S1
+2 ;
+3 NEW DA,DIC,DIE,DR,IBPLNOLD
+4 SET IBPLNOLD=$$GET1^DIQ(355.3,IBCNGP,6.01,"I")
+5 SET DA=IBSEL
SET DIC="^IBA(355.3,"
SET DIE=DIC
SET DR="6.01///@"
+6 IF IBPLNOLD'=""
SET DR=DR_";1.07///NOW;1.08////"_DUZ
+7 DO ^DIE
+8 DO INIT
+9 ;
+10 SET IBX=0
FOR
SET IBX=$ORDER(VALMY(IBX))
if 'IBX
QUIT
SET ^TMP($JOB,"IBSEL",+$GET(^TMP("IBCNR",$JOB,"IDX",IBX,IBX)))=""
+11 ;
+12 DO SPQ
+13 QUIT
+14 ;
S1 ;
+1 NEW DIR,DIRUT,DUOUT,DTOUT,DIROUT,IBOK,IBQUIT,Y
+2 DO EN^VALM2($GET(XQORNOD(0)),"S")
DO FULL^VALM1
+3 SET IBX=$ORDER(VALMY(0))
SET VALMBCK="R"
+4 ;
+5 IF 'IBX
WRITE !!,"No group selected!"
GOTO SPQ
+6 IF 'IBMULT
Begin DoDot:1
+7 IF $ORDER(VALMY(IBX))
WRITE !!,*7,"You may only select a single plan!"
QUIT
+8 IF $GET(IBALR)
IF +$GET(^TMP("IBCNR",$JOB,"IDX",IBX,IBX))=IBALR
WRITE !!,*7,"This plan is not allowed for selection!"
QUIT
+9 DO OK^IBCNSM3
+10 IF IBQUIT
SET VALMBCK="Q"
QUIT
+11 ;I IBOK S IBSEL=+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX)),VALMBCK="Q"
+12 IF IBOK
SET IBSEL=+$GET(^TMP("IBCNR",$JOB,"IDX1",IBX))
SET VALMBCK="Q"
End DoDot:1
GOTO SPQ
+13 ;
+14 ;S IBSEL=+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX))
+15 SET IBSEL=+$GET(^TMP("IBCNR",$JOB,"IDX1",IBX))
+16 QUIT
+17 ;
SPQ ;
+1 IF '$ORDER(IBSEL(0))
IF VALMBCK="R"
DO PAUSE^VALM1
+2 QUIT
