IBEMTBC ;ALB/RLW - IB MEANS TEST BILLING CLOCK FILE UPDATE ; 15-JAN-92
;;2.0;INTEGRATED BILLING;**153,199,704**;21-MAR-94;Build 49
;Per VA Directive 6402, this routine should not be modified.
;
EN ; Entry point for Clock Maintenance
;
;I $D(XRT0) S:'$D(XRTN) XRTN="IBEMTBC" D T1^%ZOSV ;stop rt clock
;S XRTL=$ZU(0),XRTN="IBEMTBC-1" D T0^%ZOSV ;start rt clock
;
D HOME^%ZIS,NOW^%DTC S IBDT=% K % I '$D(DT) D DT^DICRW
N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
S DIR(0)="PO^2:AEMQZ" D ^DIR K DIR S DFN=+Y I $D(DIRUT) G ENQ
I $$BILST^DGMTUB(DFN)=0 S J=5 D ERR G EN
I $D(^IBE(351,"ACT",DFN)) S IBSELECT="ADJUST",IBDR="[IB BILLING CYCLE ADJUST]" D ADJUST,CLEANUP G ENQ
S IBSELECT="ADD",IBDR="[IB BILLING CYCLE ADD]" D ADDNEW,CLEANUP
;
ENQ I '$D(DIRUT) W ! G EN
K DIC,IBSELECT,DFN,IBDR,IBEL,DFN,IBIEN,IBDATA,J,DIRUT,IBFAC,IBSITE,IBDT,IBQRY
;
;I $D(XRT0) S:'$D(XRTN) XRTN="IBEMTBC" D T1^%ZOSV ;stop rt clock
;
Q
;
ADJUST ; - show current active clock; inactivate and add a new one
N IBQRYRN
W @IOF
S IBIEN=$O(^IBE(351,"ACT",DFN,0))
S DIC="^IBE(351,",DA=IBIEN W !! D EN^DIQ K DIC,DA
S DIR(0)="Y",DIR("A")="Do you want to update" D ^DIR K DIR Q:+Y<1
;
I $$ICN^IBARXMU(DFN),'$$GET1^DIQ(351,IBIEN,16,"I") D ;
.W !!,"Local Clock not queried." D EDTCLCK^IBECECQ1(DFN,DT) S IBQRYRN=1
I $G(IBFLAG1) W !,"Queried billing clock found and local clock has been updated." S IBIEN=IBECDA D
.W !!!
.S DIC="^IBE(351,",DA=IBIEN W !! D EN^DIQ K DIC,DA
I $G(IBFLAG1) S DIR(0)="Y",DIR("A")="Do you still want to update" D ^DIR K DIR Q:+Y<1
; - save current clock, change to cancelled and delete "ACT" xref
I '$G(IBFLAG1),IBSELECT'="ADD",$G(IBQRYRN) W !!,"No queried clocks found.",!
K ^IBE(351,"ACT",DFN) L +(^IBE(351,IBIEN)):$G(DILOCKTM,3)
S IBDATA=$P(^IBE(351,IBIEN,0),"^",2,10),$P(^IBE(351,IBIEN,0),"^",4)=3,$P(^(1),"^",3,4)=DUZ_"^"_IBDT
D EN^IBECECU1(DFN,IBIEN) ;Send update after cancel
S IBQRY=$P(^IBE(351,IBIEN,1),"^",5),IBCLSTDT=$$GET1^DIQ(351,IBIEN,.03,"I")
L -(^IBE(351,IBIEN))
;
ADDNEW ; - add a new clock and allow updating
I IBSELECT="ADD" D Q:'Y W !
.W !!,"This patient does not have an active billing clock!"
.S DIR(0)="Y",DIR("A")="Is it okay to add a new billing clock for this patient"
.D ^DIR K DIR,DIRUT,DUOUT,DTOUT
;
D SITE^IBAUTL I 'IBSITE S J=1 G ERR
S I=$P($S($D(^IBE(351,0)):^(0),1:"^^-1"),"^",3)+1 I 'I S J=3 G ERR
K DD,DO,DIC,DR S DIC="^IBE(351,",DIC(0)="L",DLAYGO=351,DIC("DR")=".02////"_DFN_";11////"_DUZ_";12////"_IBDT
F I=I:1 I I>0,'$D(^IBE(351,I)) L +^IBE(351,I):2 I $T,'$D(^IBE(351,I)) S DINUM=I,X=+IBSITE_I D FILE^DICN K DIC,DR S IBCL=+Y Q:+Y>0
L -^IBE(351,IBCL)
I IBSELECT'="ADD" S $P(^IBE(351,IBCL,0),"^",2,10)=IBDATA,$P(^IBE(351,IBCL,1),"^",5)=IBQRY,DIK="^IBE(351,",DA=IBCL D IX1^DIK K DIK
I IBSELECT="ADD" S DIE="^IBE(351,",DA=IBCL,DR=".03" D ^DIE I $$GET1^DIQ(351,IBCL,.03,"I") D EDTCLCK^IBECECQ1(DFN,$$GET1^DIQ(351,IBCL,.03,"I")) I $G(IBFLAG1) D Q:$G(IBQUIT)
.W !!,"***Active Billing Clock returned from query."
.S IBIEN=IBCL,IBCL=IBECDA,IBSELECT="ADJUST",IBCLSTDT=$$GET1^DIQ(351,IBCL,.03,"I")
.I IBIEN'=IBCL S DA=IBIEN,DIK="^IBE(351," D ^DIK K DIK,DA
.K DR W !!!
.S DIC="^IBE(351,",DA=IBCL W !! D EN^DIQ K DIC,DA
.S DIR(0)="Y",DIR("A")="Do you want to update" D ^DIR K DIR I Y<1 S IBQUIT=1
I '$$GET1^DIQ(351,IBCL,.03,"I") D Q
.W !!,"This new clock is incomplete!! Deleting the clock from the system..."
.S DA=IBCL,DIK="^IBE(351," D ^DIK K DIK,DA
I IBSELECT="ADD" W !!,"No queried clocks found.",!
I IBSELECT'="ADD" L +^IBE(351,IBCL):$G(DILOCKTM,5) S DIE="^IBE(351,",DA=IBCL,DR=".03" D ^DIE I $$GET1^DIQ(351,IBCL,.03,"I")'=IBCLSTDT S $P(^IBE(351,IBCL,1),"^",5)="" L -^IBE(351,IBCL)
I IBSELECT'="ADD",'$P(^IBE(351,IBCL,1),"^",5),'$G(IBQRYRN) W !!,"Billing Clock start date change requires new Query, please wait." D CLNCLK,EDTCLCK^IBECECQ1(DFN,$$GET1^DIQ(351,IBCL,.03,"I")) I $G(IBFLAG1) D
.W !!!,"Queried billing clock found and local clock has been updated."
.S DA=IBCL,DIK="^IBE(351," D ^DIK K DIK,DA
.S IBCL=IBECDA
.K DR W !
.S DIC="^IBE(351,",DA=IBCL W !! D EN^DIQ K DIC,DA
.S DIR(0)="Y",DIR("A")="Do you still want to update" D ^DIR K DIR I +Y<1 S IBQUIT=1
I $G(IBQUIT) D EN^IBECECU1(DFN,IBCL) Q
I '$G(IBFLAG1),IBSELECT'="ADD",$$GET1^DIQ(351,IBCL,.03,"I")'=IBCLSTDT W !!,"No queried clocks found.",!
L +^IBE(351,IBCL):$G(DILOCKTM,5) S DIE="^IBE(351,",DA=IBCL,DR=IBDR D ^DIE K DA,DIE,DR S $P(^IBE(351,IBCL,1),"^",5)=1
L -^IBE(351,IBCL)
;
; - if the updated clock was cancelled, with no other changes made,
; - move the update reason over to the old clock and cancel the new one.
I IBSELECT'="ADD" D
.Q:'$D(^IBE(351,+$G(IBIEN))) Q:IBCL=IBIEN
.I $L(^IBE(351,+$G(IBIEN),0),"^")=9 S $P(^IBE(351,+$G(IBIEN),0),"^",10)=""
.I $L(^IBE(351,IBCL,0),"^")=9 S $P(^IBE(351,IBCL,0),"^",10)=""
.Q:$P(^IBE(351,+$G(IBIEN),0),"^",2,10)'=$P(^IBE(351,IBCL,0),"^",2,10)
.W !!,"Since you only cancelled the clock, I'll delete the new clock..."
.I $P(^IBE(351,IBCL,0),"^",11)]"" S $P(^IBE(351,+$G(IBIEN),0),"^",11)=$P(^IBE(351,IBCL,0),"^",11) W !,"(but I'll save the update reason)..."
.S $P(^IBE(351,IBIEN,0),"^",16)=1
.S DA=IBCL,DIK="^IBE(351," D ^DIK K DIK,DA
;
; - if the user is adding a new clock, and there is no clock
; - begin date or status, delete the clock.
I IBSELECT="ADD" S IBDATA=^IBE(351,IBCL,0) I '$P(IBDATA,"^",3)!'$P(IBDATA,"^",4) D
.W !!,"This new clock is incomplete!! Deleting the clock from the system..."
.S DA=IBCL,DIK="^IBE(351," D ^DIK K DIK,DA
I $D(^IBE(351,IBCL)),$$GET1^DIQ(351,IBCL,16,"I") D EN^IBECECU1(DFN,IBCL)
K IBCL
Q
CLNCLK ;Clean up old clock
S IBIEN=IBCL
K ^IBE(351,"ACT",DFN) L +(^IBE(351,IBIEN)):$G(DILOCKTM,3)
S IBDATA=$P(^IBE(351,IBIEN,0),"^",2,10),$P(^IBE(351,IBIEN,0),"^",4)=3,$P(^(1),"^",3,4)=DUZ_"^"_IBDT
S IBQRY=$P(^IBE(351,IBIEN,1),"^",5)
L -(^IBE(351,IBIEN))
S I=$P($S($D(^IBE(351,0)):^(0),1:"^^-1"),"^",3)+1 I 'I S J=3 G ERR
K DD,DO,DIC,DR S DIC="^IBE(351,",DIC(0)="L",DLAYGO=351,DIC("DR")=".02////"_DFN_";11////"_DUZ_";12////"_IBDT
F I=I:1 I I>0,'$D(^IBE(351,I)) L +^IBE(351,I):2 I $T,'$D(^IBE(351,I)) S DINUM=I,X=+IBSITE_I D FILE^DICN K DIC,DR S IBCL=+Y Q:+Y>0
S $P(^IBE(351,IBCL,0),"^",2,10)=IBDATA,$P(^IBE(351,IBCL,1),"^",5)=IBQRY,DIK="^IBE(351,",DA=IBCL D IX1^DIK K DIK
L -^IBE(351,IBCL)
Q
;
ERR ; - display error messages
W !?5,$P($T(ERRMSG+J),";;",2)
CLEANUP K IBCLDA,IBCLDAY,IBCLDT,IBMED,IBCLDOL,X,IBSELECT,DLAYGO,IBDTK,IBFLAG1,DR,IBECDA,IBQUIT,IBCLSTDT
Q
;
ERRMSG ; - possible error messages
;;No value returned from call to SITE^IBAUTL
;;Record locked, try again later!
;;Problem extracting last IFN from zeroth node of MEANS TEST BILLING CLOCK file
;;Unable to add record to MEANS TEST BILLING CLOCK file
;;Not a Means Test copay patient!
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEMTBC 6863 printed Dec 13, 2024@02:22:04 Page 2
IBEMTBC ;ALB/RLW - IB MEANS TEST BILLING CLOCK FILE UPDATE ; 15-JAN-92
+1 ;;2.0;INTEGRATED BILLING;**153,199,704**;21-MAR-94;Build 49
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; Entry point for Clock Maintenance
+1 ;
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBEMTBC" D T1^%ZOSV ;stop rt clock
+3 ;S XRTL=$ZU(0),XRTN="IBEMTBC-1" D T0^%ZOSV ;start rt clock
+4 ;
+5 DO HOME^%ZIS
DO NOW^%DTC
SET IBDT=%
KILL %
IF '$DATA(DT)
DO DT^DICRW
+6 ;Suppress PATIENT file fuzzy lookups
NEW DPTNOFZY
SET DPTNOFZY=1
+7 SET DIR(0)="PO^2:AEMQZ"
DO ^DIR
KILL DIR
SET DFN=+Y
IF $DATA(DIRUT)
GOTO ENQ
+8 IF $$BILST^DGMTUB(DFN)=0
SET J=5
DO ERR
GOTO EN
+9 IF $DATA(^IBE(351,"ACT",DFN))
SET IBSELECT="ADJUST"
SET IBDR="[IB BILLING CYCLE ADJUST]"
DO ADJUST
DO CLEANUP
GOTO ENQ
+10 SET IBSELECT="ADD"
SET IBDR="[IB BILLING CYCLE ADD]"
DO ADDNEW
DO CLEANUP
+11 ;
ENQ IF '$DATA(DIRUT)
WRITE !
GOTO EN
+1 KILL DIC,IBSELECT,DFN,IBDR,IBEL,DFN,IBIEN,IBDATA,J,DIRUT,IBFAC,IBSITE,IBDT,IBQRY
+2 ;
+3 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBEMTBC" D T1^%ZOSV ;stop rt clock
+4 ;
+5 QUIT
+6 ;
ADJUST ; - show current active clock; inactivate and add a new one
+1 NEW IBQRYRN
+2 WRITE @IOF
+3 SET IBIEN=$ORDER(^IBE(351,"ACT",DFN,0))
+4 SET DIC="^IBE(351,"
SET DA=IBIEN
WRITE !!
DO EN^DIQ
KILL DIC,DA
+5 SET DIR(0)="Y"
SET DIR("A")="Do you want to update"
DO ^DIR
KILL DIR
if +Y<1
QUIT
+6 ;
+7 ;
IF $$ICN^IBARXMU(DFN)
IF '$$GET1^DIQ(351,IBIEN,16,"I")
Begin DoDot:1
+8 WRITE !!,"Local Clock not queried."
DO EDTCLCK^IBECECQ1(DFN,DT)
SET IBQRYRN=1
End DoDot:1
+9 IF $GET(IBFLAG1)
WRITE !,"Queried billing clock found and local clock has been updated."
SET IBIEN=IBECDA
Begin DoDot:1
+10 WRITE !!!
+11 SET DIC="^IBE(351,"
SET DA=IBIEN
WRITE !!
DO EN^DIQ
KILL DIC,DA
End DoDot:1
+12 IF $GET(IBFLAG1)
SET DIR(0)="Y"
SET DIR("A")="Do you still want to update"
DO ^DIR
KILL DIR
if +Y<1
QUIT
+13 ; - save current clock, change to cancelled and delete "ACT" xref
+14 IF '$GET(IBFLAG1)
IF IBSELECT'="ADD"
IF $GET(IBQRYRN)
WRITE !!,"No queried clocks found.",!
+15 KILL ^IBE(351,"ACT",DFN)
LOCK +(^IBE(351,IBIEN)):$GET(DILOCKTM,3)
+16 SET IBDATA=$PIECE(^IBE(351,IBIEN,0),"^",2,10)
SET $PIECE(^IBE(351,IBIEN,0),"^",4)=3
SET $PIECE(^(1),"^",3,4)=DUZ_"^"_IBDT
+17 ;Send update after cancel
DO EN^IBECECU1(DFN,IBIEN)
+18 SET IBQRY=$PIECE(^IBE(351,IBIEN,1),"^",5)
SET IBCLSTDT=$$GET1^DIQ(351,IBIEN,.03,"I")
+19 LOCK -(^IBE(351,IBIEN))
+20 ;
ADDNEW ; - add a new clock and allow updating
+1 IF IBSELECT="ADD"
Begin DoDot:1
+2 WRITE !!,"This patient does not have an active billing clock!"
+3 SET DIR(0)="Y"
SET DIR("A")="Is it okay to add a new billing clock for this patient"
+4 DO ^DIR
KILL DIR,DIRUT,DUOUT,DTOUT
End DoDot:1
if 'Y
QUIT
WRITE !
+5 ;
+6 DO SITE^IBAUTL
IF 'IBSITE
SET J=1
GOTO ERR
+7 SET I=$PIECE($SELECT($DATA(^IBE(351,0)):^(0),1:"^^-1"),"^",3)+1
IF 'I
SET J=3
GOTO ERR
+8 KILL DD,DO,DIC,DR
SET DIC="^IBE(351,"
SET DIC(0)="L"
SET DLAYGO=351
SET DIC("DR")=".02////"_DFN_";11////"_DUZ_";12////"_IBDT
+9 FOR I=I:1
IF I>0
IF '$DATA(^IBE(351,I))
LOCK +^IBE(351,I):2
IF $TEST
IF '$DATA(^IBE(351,I))
SET DINUM=I
SET X=+IBSITE_I
DO FILE^DICN
KILL DIC,DR
SET IBCL=+Y
if +Y>0
QUIT
+10 LOCK -^IBE(351,IBCL)
+11 IF IBSELECT'="ADD"
SET $PIECE(^IBE(351,IBCL,0),"^",2,10)=IBDATA
SET $PIECE(^IBE(351,IBCL,1),"^",5)=IBQRY
SET DIK="^IBE(351,"
SET DA=IBCL
DO IX1^DIK
KILL DIK
+12 IF IBSELECT="ADD"
SET DIE="^IBE(351,"
SET DA=IBCL
SET DR=".03"
DO ^DIE
IF $$GET1^DIQ(351,IBCL,.03,"I")
DO EDTCLCK^IBECECQ1(DFN,$$GET1^DIQ(351,IBCL,.03,"I"))
IF $GET(IBFLAG1)
Begin DoDot:1
+13 WRITE !!,"***Active Billing Clock returned from query."
+14 SET IBIEN=IBCL
SET IBCL=IBECDA
SET IBSELECT="ADJUST"
SET IBCLSTDT=$$GET1^DIQ(351,IBCL,.03,"I")
+15 IF IBIEN'=IBCL
SET DA=IBIEN
SET DIK="^IBE(351,"
DO ^DIK
KILL DIK,DA
+16 KILL DR
WRITE !!!
+17 SET DIC="^IBE(351,"
SET DA=IBCL
WRITE !!
DO EN^DIQ
KILL DIC,DA
+18 SET DIR(0)="Y"
SET DIR("A")="Do you want to update"
DO ^DIR
KILL DIR
IF Y<1
SET IBQUIT=1
End DoDot:1
if $GET(IBQUIT)
QUIT
+19 IF '$$GET1^DIQ(351,IBCL,.03,"I")
Begin DoDot:1
+20 WRITE !!,"This new clock is incomplete!! Deleting the clock from the system..."
+21 SET DA=IBCL
SET DIK="^IBE(351,"
DO ^DIK
KILL DIK,DA
End DoDot:1
QUIT
+22 IF IBSELECT="ADD"
WRITE !!,"No queried clocks found.",!
+23 IF IBSELECT'="ADD"
LOCK +^IBE(351,IBCL):$GET(DILOCKTM,5)
SET DIE="^IBE(351,"
SET DA=IBCL
SET DR=".03"
DO ^DIE
IF $$GET1^DIQ(351,IBCL,.03,"I")'=IBCLSTDT
SET $PIECE(^IBE(351,IBCL,1),"^",5)=""
LOCK -^IBE(351,IBCL)
+24 IF IBSELECT'="ADD"
IF '$PIECE(^IBE(351,IBCL,1),"^",5)
IF '$GET(IBQRYRN)
WRITE !!,"Billing Clock start date change requires new Query, please wait."
DO CLNCLK
DO EDTCLCK^IBECECQ1(DFN,$$GET1^DIQ(351,IBCL,.03,"I"))
IF $GET(IBFLAG1)
Begin DoDot:1
+25 WRITE !!!,"Queried billing clock found and local clock has been updated."
+26 SET DA=IBCL
SET DIK="^IBE(351,"
DO ^DIK
KILL DIK,DA
+27 SET IBCL=IBECDA
+28 KILL DR
WRITE !
+29 SET DIC="^IBE(351,"
SET DA=IBCL
WRITE !!
DO EN^DIQ
KILL DIC,DA
+30 SET DIR(0)="Y"
SET DIR("A")="Do you still want to update"
DO ^DIR
KILL DIR
IF +Y<1
SET IBQUIT=1
End DoDot:1
+31 IF $GET(IBQUIT)
DO EN^IBECECU1(DFN,IBCL)
QUIT
+32 IF '$GET(IBFLAG1)
IF IBSELECT'="ADD"
IF $$GET1^DIQ(351,IBCL,.03,"I")'=IBCLSTDT
WRITE !!,"No queried clocks found.",!
+33 LOCK +^IBE(351,IBCL):$GET(DILOCKTM,5)
SET DIE="^IBE(351,"
SET DA=IBCL
SET DR=IBDR
DO ^DIE
KILL DA,DIE,DR
SET $PIECE(^IBE(351,IBCL,1),"^",5)=1
+34 LOCK -^IBE(351,IBCL)
+35 ;
+36 ; - if the updated clock was cancelled, with no other changes made,
+37 ; - move the update reason over to the old clock and cancel the new one.
+38 IF IBSELECT'="ADD"
Begin DoDot:1
+39 if '$DATA(^IBE(351,+$GET(IBIEN)))
QUIT
if IBCL=IBIEN
QUIT
+40 IF $LENGTH(^IBE(351,+$GET(IBIEN),0),"^")=9
SET $PIECE(^IBE(351,+$GET(IBIEN),0),"^",10)=""
+41 IF $LENGTH(^IBE(351,IBCL,0),"^")=9
SET $PIECE(^IBE(351,IBCL,0),"^",10)=""
+42 if $PIECE(^IBE(351,+$GET(IBIEN),0),"^",2,10)'=$PIECE(^IBE(351,IBCL,0),"^",2,10)
QUIT
+43 WRITE !!,"Since you only cancelled the clock, I'll delete the new clock..."
+44 IF $PIECE(^IBE(351,IBCL,0),"^",11)]""
SET $PIECE(^IBE(351,+$GET(IBIEN),0),"^",11)=$PIECE(^IBE(351,IBCL,0),"^",11)
WRITE !,"(but I'll save the update reason)..."
+45 SET $PIECE(^IBE(351,IBIEN,0),"^",16)=1
+46 SET DA=IBCL
SET DIK="^IBE(351,"
DO ^DIK
KILL DIK,DA
End DoDot:1
+47 ;
+48 ; - if the user is adding a new clock, and there is no clock
+49 ; - begin date or status, delete the clock.
+50 IF IBSELECT="ADD"
SET IBDATA=^IBE(351,IBCL,0)
IF '$PIECE(IBDATA,"^",3)!'$PIECE(IBDATA,"^",4)
Begin DoDot:1
+51 WRITE !!,"This new clock is incomplete!! Deleting the clock from the system..."
+52 SET DA=IBCL
SET DIK="^IBE(351,"
DO ^DIK
KILL DIK,DA
End DoDot:1
+53 IF $DATA(^IBE(351,IBCL))
IF $$GET1^DIQ(351,IBCL,16,"I")
DO EN^IBECECU1(DFN,IBCL)
+54 KILL IBCL
+55 QUIT
CLNCLK ;Clean up old clock
+1 SET IBIEN=IBCL
+2 KILL ^IBE(351,"ACT",DFN)
LOCK +(^IBE(351,IBIEN)):$GET(DILOCKTM,3)
+3 SET IBDATA=$PIECE(^IBE(351,IBIEN,0),"^",2,10)
SET $PIECE(^IBE(351,IBIEN,0),"^",4)=3
SET $PIECE(^(1),"^",3,4)=DUZ_"^"_IBDT
+4 SET IBQRY=$PIECE(^IBE(351,IBIEN,1),"^",5)
+5 LOCK -(^IBE(351,IBIEN))
+6 SET I=$PIECE($SELECT($DATA(^IBE(351,0)):^(0),1:"^^-1"),"^",3)+1
IF 'I
SET J=3
GOTO ERR
+7 KILL DD,DO,DIC,DR
SET DIC="^IBE(351,"
SET DIC(0)="L"
SET DLAYGO=351
SET DIC("DR")=".02////"_DFN_";11////"_DUZ_";12////"_IBDT
+8 FOR I=I:1
IF I>0
IF '$DATA(^IBE(351,I))
LOCK +^IBE(351,I):2
IF $TEST
IF '$DATA(^IBE(351,I))
SET DINUM=I
SET X=+IBSITE_I
DO FILE^DICN
KILL DIC,DR
SET IBCL=+Y
if +Y>0
QUIT
+9 SET $PIECE(^IBE(351,IBCL,0),"^",2,10)=IBDATA
SET $PIECE(^IBE(351,IBCL,1),"^",5)=IBQRY
SET DIK="^IBE(351,"
SET DA=IBCL
DO IX1^DIK
KILL DIK
+10 LOCK -^IBE(351,IBCL)
+11 QUIT
+12 ;
ERR ; - display error messages
+1 WRITE !?5,$PIECE($TEXT(ERRMSG+J),";;",2)
CLEANUP KILL IBCLDA,IBCLDAY,IBCLDT,IBMED,IBCLDOL,X,IBSELECT,DLAYGO,IBDTK,IBFLAG1,DR,IBECDA,IBQUIT,IBCLSTDT
+1 QUIT
+2 ;
ERRMSG ; - possible error messages
+1 ;;No value returned from call to SITE^IBAUTL
+2 ;;Record locked, try again later!
+3 ;;Problem extracting last IFN from zeroth node of MEANS TEST BILLING CLOCK file
+4 ;;Unable to add record to MEANS TEST BILLING CLOCK file
+5 ;;Not a Means Test copay patient!
