IBCEMCL ;ALB/ESG - Multiple CSA Message Management ;20-SEP-2005
;;2.0;INTEGRATED BILLING;**320**;21-MAR-1994
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
Q
EN ; -- main entry point
L +^IBM("MCS"):0 I '$T D Q ; option level lock
. W !!?2,"Sorry, another user is currently using the MCS option."
. W !?2,"Please try again later."
. D PAUSE^VALM1
. Q
;
K ^TMP($J,"IBCEMCA"),^TMP($J,"IBCEMCL")
D EN^VALM("IBCEMC MCS MESSAGE LIST")
L -^IBM("MCS") ; option level unlock
Q
;
HDR ; -- header code
NEW Z,NUMSEL,TOT
S NUMSEL=+$G(^TMP($J,"IBCEMCL",4)) ; number selected
S TOT=+$O(^TMP($J,"IBCEMCL",3,""),-1) ; total number in list
S Z="Number of Claims Selected: "
S Z=Z_$$FO^IBCNEUT1(NUMSEL,8)
S Z=Z_$$FO^IBCNEUT1(" ",10)
S Z=Z_"Total Number in this List: "
S Z=Z_$$FO^IBCNEUT1(TOT,8)
S VALMHDR(1)=Z
Q
;
INIT ; -- init variables and list array
NEW A,CLAIM,DATA,EDI,IB,IB0,IB361,IB364,IBCNT,IBCURBAL,IBDA,IBDATE
NEW IBDIV,IBIFN,IBPAT,IBREV,IBSSN,IBSTSMSG,IBSVC,IBU1,INCLUDE,INS
NEW INSTID,PAYER,PROFID,SELTXT,TXT,X
W !!,"Compiling MCS Data ... "
KILL ^TMP($J,"IBCEMCL") ; List related scratch global
S IBREV=""
F S IBREV=$O(^IBM(361,"ACSA","R",IBREV)) Q:IBREV="" I IBREV<2 S IBDA=0 F S IBDA=$O(^IBM(361,"ACSA","R",IBREV,IBDA)) Q:'IBDA D
. S IB361=$G(^IBM(361,IBDA,0)),IBIFN=+IB361
. S IB0=$G(^DGCR(399,IBIFN,0))
. ;
. ; no cancelled claims
. I $P(IB0,U,13)=7 D UPDEDI^IBCEM(+$P(IB361,U,11),"C") Q
. ;
. ; automatically review this message if the claim was last printed on
. ; or after the MCS - 'Resubmit by Print' date
. I $P(IB361,U,16),($P($G(^DGCR(399,IBIFN,"S")),U,14)\1)'<$P(IB361,U,16) D UPDEDI^IBCEM(+$P(IB361,U,11),"P") Q
. ;
. ; payer
. S INS=+$P($G(^DGCR(399,IBIFN,"MP")),U,1)
. I 'INS S INS=+$$CURR^IBCEF2(IBIFN)
. I INS S PAYER=$P($G(^DIC(36,INS,0)),U,1)
. I 'INS S PAYER="~unknown payer"
. ;
. ; screen for user selected payers
. I $D(^TMP($J,"IBCEMCA","INS")) D Q:'INCLUDE
.. S INCLUDE=0
.. I 'INS Q ; don't include if the payer can't be found
.. I $D(^TMP($J,"IBCEMCA","INS",1,INS)) S INCLUDE=1 Q
.. I '$D(^TMP($J,"IBCEMCA","INS",2)) Q
.. S EDI=$$UP^XLFSTR($G(^DIC(36,INS,3)))
.. S PROFID=$P(EDI,U,2),INSTID=$P(EDI,U,4)
.. I PROFID'="",$D(^TMP($J,"IBCEMCA","INS",2,PROFID)) S INCLUDE=1 Q
.. I INSTID'="",$D(^TMP($J,"IBCEMCA","INS",2,INSTID)) S INCLUDE=1 Q
.. Q
. ;
. ; screen for user selected divisions
. I $D(^TMP($J,"IBCEMCA","DIV")) D Q:'INCLUDE
.. S INCLUDE=0
.. S IBDIV=+$P(IB0,U,22) I 'IBDIV Q
.. I $D(^TMP($J,"IBCEMCA","DIV",IBDIV)) S INCLUDE=1 Q
.. Q
. ;
. S IBSTSMSG=$$TXT^IBCECSA1(IBDA,300) ; status message text
. I IBSTSMSG="" S IBSTSMSG="~no error text"
. ;
. ; screen for user selected error message text
. I $D(^TMP($J,"IBCEMCA","TEXT")) D Q:'INCLUDE
.. S INCLUDE=0
.. S SELTXT="" F S SELTXT=$O(^TMP($J,"IBCEMCA","TEXT",SELTXT)) Q:SELTXT="" I IBSTSMSG[SELTXT S INCLUDE=1 Q
.. Q
. ;
. ; screen for user selected date range
. I $D(^TMP($J,"IBCEMCA","DATE")) D Q:'INCLUDE
.. S INCLUDE=0,A=^TMP($J,"IBCEMCA","DATE")
.. S IBDATE=$P(IB361,U,2) ; date message received
.. I ($P(A,U,1)'>IBDATE),(IBDATE'>$P(A,U,2)) S INCLUDE=1 Q
.. Q
. ;
. ; patient and ssn
. S IBPAT=$G(^DPT(+$P(IB0,U,2),0))
. S IBSSN=$E($P(IBPAT,U,9),6,9)
. S IBPAT=$P(IBPAT,U,1)
. ;
. S IBSVC=$P($G(^DGCR(399,IBIFN,"U")),U,1) ; statement covers from
. S IB364=$P(IB361,U,11) ; transmission file entry
. S IBU1=$G(^DGCR(399,IBIFN,"U1"))
. S IBCURBAL=$P(IBU1,U,1)-$P(IBU1,U,2) ; current balance
. S CLAIM=$P(IB0,U,1) ; external bill#
. ;
. S DATA=IBIFN_U_IB364_U_CLAIM_U_PAYER_U_IBPAT_U_IBSSN_U_IBSVC_U_IBCURBAL
. S ^TMP($J,"IBCEMCL",1,$E(IBSTSMSG,1,80),IBDA)=DATA
. Q
;
I '$D(^TMP($J,"IBCEMCL",1)) D G INITX
. S VALMCNT=2
. S ^TMP($J,"IBCEMCL",2,1,0)=""
. S ^TMP($J,"IBCEMCL",2,2,0)=" No Status Message Data to Display"
. Q
;
BLD ; Build the display area of the list
;
W !,"Building the MCS list display ... "
S TXT="",IBCNT=0,VALMCNT=0
F S TXT=$O(^TMP($J,"IBCEMCL",1,TXT)) Q:TXT="" D
. D SET("")
. D SET(TXT)
. S IBDA=0
. F S IBDA=$O(^TMP($J,"IBCEMCL",1,TXT,IBDA)) Q:'IBDA D
.. S IB=$G(^TMP($J,"IBCEMCL",1,TXT,IBDA)),IBIFN=+IB,IB364=$P(IB,U,2)
.. S IBCNT=IBCNT+1,DATA=IBIFN_U_IBDA_U_IB364
.. S X=$$SETFLD^VALM1($J(IBCNT,3),"","NUMBER")
.. S X=$$SETFLD^VALM1($P(IB,U,3),X,"BILL")
.. S X=$$SETFLD^VALM1($P(IB,U,4),X,"PAYER")
.. S X=$$SETFLD^VALM1($P(IB,U,5),X,"PATIENT")
.. S X=$$SETFLD^VALM1($P(IB,U,6),X,"SSN")
.. S X=$$SETFLD^VALM1($$FMTE^XLFDT($P(IB,U,7),"2Z"),X,"SERVICE")
.. S X=$$SETFLD^VALM1($J("$"_$FN($P(IB,U,8),"",2),10),X,"CURBAL")
.. D SET(X,IBCNT,DATA)
.. Q
. Q
;
INITX ;
Q
;
SET(X,CNT,DATA) ; Set an entry into the display array and scratch global
; X - visual line to display
; CNT - current record counter
; DATA - 3 piece string IBIFN^IBDA^IB364 (optional)
I X="",'VALMCNT G SETX ; don't start list with a blank line
S VALMCNT=VALMCNT+1
I '$G(CNT) S CNT=$G(IBCNT)+1
S ^TMP($J,"IBCEMCL",2,VALMCNT,0)=X
S ^TMP($J,"IBCEMCL",2,"IDX",VALMCNT,CNT)=""
I $G(DATA)="" G SETX
;
S ^TMP($J,"IBCEMCL",3,CNT)=DATA_U_VALMCNT
;
; When building the list and the ^TMP($J,"IBCEMCA") area is defined,
; then automatically pre-select all entries in the list.
I $D(^TMP($J,"IBCEMCA")) D MARK(+$P(DATA,U,2),+DATA,VALMCNT,CNT)
SETX ;
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D UNLOCK
KILL ^TMP($J,"IBCEMCL"),^TMP($J,"IBCEMCA")
Q
;
UNLOCK ; unlock any entries that may still be selected
N IBDA S IBDA=0
F S IBDA=$O(^TMP($J,"IBCEMCL",4,1,IBDA)) Q:'IBDA L -^IBM(361,IBDA)
UNLOCKX ;
Q
;
MARK(IBDA,IBIFN,VALMCNT,INDEX,RESULT) ; Select/De-select Entry in List.
; This procedure toggles the selection of a status message either
; ON or OFF. It also adds or removes the "*" to the list display.
; If a selection can't be locked, then it will not be selected.
; VALMHDR is killed so ListManager will invoke the header code.
;
; RESULT is returned if passed by reference
; "D" message was de-selected and unlocked
; "S" message was selected and locked
; "L" message could not be locked nor selected
;
I $D(^TMP($J,"IBCEMCL",4,1,IBDA)) D G MARKX ; already selected
. ;
. ; de-select action
. KILL ^TMP($J,"IBCEMCL",4,1,IBDA)
. KILL ^TMP($J,"IBCEMCL",4,2,IBIFN,IBDA)
. S ^TMP($J,"IBCEMCL",4)=$G(^TMP($J,"IBCEMCL",4))-1
. S $E(^TMP($J,"IBCEMCL",2,VALMCNT,0),6)=" "
. KILL VALMHDR
. L -^IBM(361,IBDA) ; unlock
. S RESULT="D"
. Q
;
; lock attempt prior to selection
L +^IBM(361,IBDA):0 I '$T D G MARKX
. S RESULT="L"
. Q
;
; select action
S ^TMP($J,"IBCEMCL",4,1,IBDA)=IBIFN_U_VALMCNT_U_INDEX
S ^TMP($J,"IBCEMCL",4,2,IBIFN,IBDA)=""
S ^TMP($J,"IBCEMCL",4)=$G(^TMP($J,"IBCEMCL",4))+1
S $E(^TMP($J,"IBCEMCL",2,VALMCNT,0),6)="*"
KILL VALMHDR
S RESULT="S"
MARKX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMCL 7121 printed Dec 13, 2024@02:10:52 Page 2
IBCEMCL ;ALB/ESG - Multiple CSA Message Management ;20-SEP-2005
+1 ;;2.0;INTEGRATED BILLING;**320**;21-MAR-1994
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 QUIT
EN ; -- main entry point
+1 ; option level lock
LOCK +^IBM("MCS"):0
IF '$TEST
Begin DoDot:1
+2 WRITE !!?2,"Sorry, another user is currently using the MCS option."
+3 WRITE !?2,"Please try again later."
+4 DO PAUSE^VALM1
+5 QUIT
End DoDot:1
QUIT
+6 ;
+7 KILL ^TMP($JOB,"IBCEMCA"),^TMP($JOB,"IBCEMCL")
+8 DO EN^VALM("IBCEMC MCS MESSAGE LIST")
+9 ; option level unlock
LOCK -^IBM("MCS")
+10 QUIT
+11 ;
HDR ; -- header code
+1 NEW Z,NUMSEL,TOT
+2 ; number selected
SET NUMSEL=+$GET(^TMP($JOB,"IBCEMCL",4))
+3 ; total number in list
SET TOT=+$ORDER(^TMP($JOB,"IBCEMCL",3,""),-1)
+4 SET Z="Number of Claims Selected: "
+5 SET Z=Z_$$FO^IBCNEUT1(NUMSEL,8)
+6 SET Z=Z_$$FO^IBCNEUT1(" ",10)
+7 SET Z=Z_"Total Number in this List: "
+8 SET Z=Z_$$FO^IBCNEUT1(TOT,8)
+9 SET VALMHDR(1)=Z
+10 QUIT
+11 ;
INIT ; -- init variables and list array
+1 NEW A,CLAIM,DATA,EDI,IB,IB0,IB361,IB364,IBCNT,IBCURBAL,IBDA,IBDATE
+2 NEW IBDIV,IBIFN,IBPAT,IBREV,IBSSN,IBSTSMSG,IBSVC,IBU1,INCLUDE,INS
+3 NEW INSTID,PAYER,PROFID,SELTXT,TXT,X
+4 WRITE !!,"Compiling MCS Data ... "
+5 ; List related scratch global
KILL ^TMP($JOB,"IBCEMCL")
+6 SET IBREV=""
+7 FOR
SET IBREV=$ORDER(^IBM(361,"ACSA","R",IBREV))
if IBREV=""
QUIT
IF IBREV<2
SET IBDA=0
FOR
SET IBDA=$ORDER(^IBM(361,"ACSA","R",IBREV,IBDA))
if 'IBDA
QUIT
Begin DoDot:1
+8 SET IB361=$GET(^IBM(361,IBDA,0))
SET IBIFN=+IB361
+9 SET IB0=$GET(^DGCR(399,IBIFN,0))
+10 ;
+11 ; no cancelled claims
+12 IF $PIECE(IB0,U,13)=7
DO UPDEDI^IBCEM(+$PIECE(IB361,U,11),"C")
QUIT
+13 ;
+14 ; automatically review this message if the claim was last printed on
+15 ; or after the MCS - 'Resubmit by Print' date
+16 IF $PIECE(IB361,U,16)
IF ($PIECE($GET(^DGCR(399,IBIFN,"S")),U,14)\1)'<$PIECE(IB361,U,16)
DO UPDEDI^IBCEM(+$PIECE(IB361,U,11),"P")
QUIT
+17 ;
+18 ; payer
+19 SET INS=+$PIECE($GET(^DGCR(399,IBIFN,"MP")),U,1)
+20 IF 'INS
SET INS=+$$CURR^IBCEF2(IBIFN)
+21 IF INS
SET PAYER=$PIECE($GET(^DIC(36,INS,0)),U,1)
+22 IF 'INS
SET PAYER="~unknown payer"
+23 ;
+24 ; screen for user selected payers
+25 IF $DATA(^TMP($JOB,"IBCEMCA","INS"))
Begin DoDot:2
+26 SET INCLUDE=0
+27 ; don't include if the payer can't be found
IF 'INS
QUIT
+28 IF $DATA(^TMP($JOB,"IBCEMCA","INS",1,INS))
SET INCLUDE=1
QUIT
+29 IF '$DATA(^TMP($JOB,"IBCEMCA","INS",2))
QUIT
+30 SET EDI=$$UP^XLFSTR($GET(^DIC(36,INS,3)))
+31 SET PROFID=$PIECE(EDI,U,2)
SET INSTID=$PIECE(EDI,U,4)
+32 IF PROFID'=""
IF $DATA(^TMP($JOB,"IBCEMCA","INS",2,PROFID))
SET INCLUDE=1
QUIT
+33 IF INSTID'=""
IF $DATA(^TMP($JOB,"IBCEMCA","INS",2,INSTID))
SET INCLUDE=1
QUIT
+34 QUIT
End DoDot:2
if 'INCLUDE
QUIT
+35 ;
+36 ; screen for user selected divisions
+37 IF $DATA(^TMP($JOB,"IBCEMCA","DIV"))
Begin DoDot:2
+38 SET INCLUDE=0
+39 SET IBDIV=+$PIECE(IB0,U,22)
IF 'IBDIV
QUIT
+40 IF $DATA(^TMP($JOB,"IBCEMCA","DIV",IBDIV))
SET INCLUDE=1
QUIT
+41 QUIT
End DoDot:2
if 'INCLUDE
QUIT
+42 ;
+43 ; status message text
SET IBSTSMSG=$$TXT^IBCECSA1(IBDA,300)
+44 IF IBSTSMSG=""
SET IBSTSMSG="~no error text"
+45 ;
+46 ; screen for user selected error message text
+47 IF $DATA(^TMP($JOB,"IBCEMCA","TEXT"))
Begin DoDot:2
+48 SET INCLUDE=0
+49 SET SELTXT=""
FOR
SET SELTXT=$ORDER(^TMP($JOB,"IBCEMCA","TEXT",SELTXT))
if SELTXT=""
QUIT
IF IBSTSMSG[SELTXT
SET INCLUDE=1
QUIT
+50 QUIT
End DoDot:2
if 'INCLUDE
QUIT
+51 ;
+52 ; screen for user selected date range
+53 IF $DATA(^TMP($JOB,"IBCEMCA","DATE"))
Begin DoDot:2
+54 SET INCLUDE=0
SET A=^TMP($JOB,"IBCEMCA","DATE")
+55 ; date message received
SET IBDATE=$PIECE(IB361,U,2)
+56 IF ($PIECE(A,U,1)'>IBDATE)
IF (IBDATE'>$PIECE(A,U,2))
SET INCLUDE=1
QUIT
+57 QUIT
End DoDot:2
if 'INCLUDE
QUIT
+58 ;
+59 ; patient and ssn
+60 SET IBPAT=$GET(^DPT(+$PIECE(IB0,U,2),0))
+61 SET IBSSN=$EXTRACT($PIECE(IBPAT,U,9),6,9)
+62 SET IBPAT=$PIECE(IBPAT,U,1)
+63 ;
+64 ; statement covers from
SET IBSVC=$PIECE($GET(^DGCR(399,IBIFN,"U")),U,1)
+65 ; transmission file entry
SET IB364=$PIECE(IB361,U,11)
+66 SET IBU1=$GET(^DGCR(399,IBIFN,"U1"))
+67 ; current balance
SET IBCURBAL=$PIECE(IBU1,U,1)-$PIECE(IBU1,U,2)
+68 ; external bill#
SET CLAIM=$PIECE(IB0,U,1)
+69 ;
+70 SET DATA=IBIFN_U_IB364_U_CLAIM_U_PAYER_U_IBPAT_U_IBSSN_U_IBSVC_U_IBCURBAL
+71 SET ^TMP($JOB,"IBCEMCL",1,$EXTRACT(IBSTSMSG,1,80),IBDA)=DATA
+72 QUIT
End DoDot:1
+73 ;
+74 IF '$DATA(^TMP($JOB,"IBCEMCL",1))
Begin DoDot:1
+75 SET VALMCNT=2
+76 SET ^TMP($JOB,"IBCEMCL",2,1,0)=""
+77 SET ^TMP($JOB,"IBCEMCL",2,2,0)=" No Status Message Data to Display"
+78 QUIT
End DoDot:1
GOTO INITX
+79 ;
BLD ; Build the display area of the list
+1 ;
+2 WRITE !,"Building the MCS list display ... "
+3 SET TXT=""
SET IBCNT=0
SET VALMCNT=0
+4 FOR
SET TXT=$ORDER(^TMP($JOB,"IBCEMCL",1,TXT))
if TXT=""
QUIT
Begin DoDot:1
+5 DO SET("")
+6 DO SET(TXT)
+7 SET IBDA=0
+8 FOR
SET IBDA=$ORDER(^TMP($JOB,"IBCEMCL",1,TXT,IBDA))
if 'IBDA
QUIT
Begin DoDot:2
+9 SET IB=$GET(^TMP($JOB,"IBCEMCL",1,TXT,IBDA))
SET IBIFN=+IB
SET IB364=$PIECE(IB,U,2)
+10 SET IBCNT=IBCNT+1
SET DATA=IBIFN_U_IBDA_U_IB364
+11 SET X=$$SETFLD^VALM1($JUSTIFY(IBCNT,3),"","NUMBER")
+12 SET X=$$SETFLD^VALM1($PIECE(IB,U,3),X,"BILL")
+13 SET X=$$SETFLD^VALM1($PIECE(IB,U,4),X,"PAYER")
+14 SET X=$$SETFLD^VALM1($PIECE(IB,U,5),X,"PATIENT")
+15 SET X=$$SETFLD^VALM1($PIECE(IB,U,6),X,"SSN")
+16 SET X=$$SETFLD^VALM1($$FMTE^XLFDT($PIECE(IB,U,7),"2Z"),X,"SERVICE")
+17 SET X=$$SETFLD^VALM1($JUSTIFY("$"_$FNUMBER($PIECE(IB,U,8),"",2),10),X,"CURBAL")
+18 DO SET(X,IBCNT,DATA)
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 ;
INITX ;
+1 QUIT
+2 ;
SET(X,CNT,DATA) ; Set an entry into the display array and scratch global
+1 ; X - visual line to display
+2 ; CNT - current record counter
+3 ; DATA - 3 piece string IBIFN^IBDA^IB364 (optional)
+4 ; don't start list with a blank line
IF X=""
IF 'VALMCNT
GOTO SETX
+5 SET VALMCNT=VALMCNT+1
+6 IF '$GET(CNT)
SET CNT=$GET(IBCNT)+1
+7 SET ^TMP($JOB,"IBCEMCL",2,VALMCNT,0)=X
+8 SET ^TMP($JOB,"IBCEMCL",2,"IDX",VALMCNT,CNT)=""
+9 IF $GET(DATA)=""
GOTO SETX
+10 ;
+11 SET ^TMP($JOB,"IBCEMCL",3,CNT)=DATA_U_VALMCNT
+12 ;
+13 ; When building the list and the ^TMP($J,"IBCEMCA") area is defined,
+14 ; then automatically pre-select all entries in the list.
+15 IF $DATA(^TMP($JOB,"IBCEMCA"))
DO MARK(+$PIECE(DATA,U,2),+DATA,VALMCNT,CNT)
SETX ;
+1 QUIT
+2 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO UNLOCK
+2 KILL ^TMP($JOB,"IBCEMCL"),^TMP($JOB,"IBCEMCA")
+3 QUIT
+4 ;
UNLOCK ; unlock any entries that may still be selected
+1 NEW IBDA
SET IBDA=0
+2 FOR
SET IBDA=$ORDER(^TMP($JOB,"IBCEMCL",4,1,IBDA))
if 'IBDA
QUIT
LOCK -^IBM(361,IBDA)
UNLOCKX ;
+1 QUIT
+2 ;
MARK(IBDA,IBIFN,VALMCNT,INDEX,RESULT) ; Select/De-select Entry in List.
+1 ; This procedure toggles the selection of a status message either
+2 ; ON or OFF. It also adds or removes the "*" to the list display.
+3 ; If a selection can't be locked, then it will not be selected.
+4 ; VALMHDR is killed so ListManager will invoke the header code.
+5 ;
+6 ; RESULT is returned if passed by reference
+7 ; "D" message was de-selected and unlocked
+8 ; "S" message was selected and locked
+9 ; "L" message could not be locked nor selected
+10 ;
+11 ; already selected
IF $DATA(^TMP($JOB,"IBCEMCL",4,1,IBDA))
Begin DoDot:1
+12 ;
+13 ; de-select action
+14 KILL ^TMP($JOB,"IBCEMCL",4,1,IBDA)
+15 KILL ^TMP($JOB,"IBCEMCL",4,2,IBIFN,IBDA)
+16 SET ^TMP($JOB,"IBCEMCL",4)=$GET(^TMP($JOB,"IBCEMCL",4))-1
+17 SET $EXTRACT(^TMP($JOB,"IBCEMCL",2,VALMCNT,0),6)=" "
+18 KILL VALMHDR
+19 ; unlock
LOCK -^IBM(361,IBDA)
+20 SET RESULT="D"
+21 QUIT
End DoDot:1
GOTO MARKX
+22 ;
+23 ; lock attempt prior to selection
+24 LOCK +^IBM(361,IBDA):0
IF '$TEST
Begin DoDot:1
+25 SET RESULT="L"
+26 QUIT
End DoDot:1
GOTO MARKX
+27 ;
+28 ; select action
+29 SET ^TMP($JOB,"IBCEMCL",4,1,IBDA)=IBIFN_U_VALMCNT_U_INDEX
+30 SET ^TMP($JOB,"IBCEMCL",4,2,IBIFN,IBDA)=""
+31 SET ^TMP($JOB,"IBCEMCL",4)=$GET(^TMP($JOB,"IBCEMCL",4))+1
+32 SET $EXTRACT(^TMP($JOB,"IBCEMCL",2,VALMCNT,0),6)="*"
+33 KILL VALMHDR
+34 SET RESULT="S"
MARKX ;
+1 QUIT
+2 ;
