IBCRTN ;ALB/AAS - EDIT BILLS RETURNED FROM AR (NEW) ; 23-MAY-90
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;MAP TO DGCRTN
;
EN1 ;
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="EN1^IBCRTN" D T1^%ZOSV ;stop rt clock
;S XRTL=$ZU(0),XRTN="EN1^IBCRTN-1" D T0^%ZOSV ;start rt clock
;
D END S IBAC=5,IBV=0 D LOOK G:'$D(IBIFN) END D EDIT,SEND:$D(IBIFN),PRINT:$D(IBIFN) L G EN1
Q
;
EN2 ;
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="EN2^IBCRTN" D T1^%ZOSV ;stop rt clock
;S XRTL=$ZU(0),XRTN="EN2^IBCRTN-1" D T0^%ZOSV ;start rt clock
;
D END S IBAC=6,IBV=1 D LOOK G END:'$D(IBIFN) D RTN,SEND:$D(IBIFN),PRINT:$D(IBIFN) L G EN2
Q
;
LOOK S DIC="^DGCR(399,",DIC(0)="AEQMZ",DIC("S")="I $S($P(^(0),U,13)=7:0,+$$RETN^PRCAFN(Y):1,1:0)" D ^DIC K DIC Q:+Y<1
S IBIFN=+Y,DFN=$P(Y(0),"^",2)
L ^DGCR(399,IBIFN):1 I '$T W !,"Already being edited by another user" K IBIFN,DFN Q
I '$P(^DGCR(399,IBIFN,"S"),"^",9)!('$D(^XUSEC("IB EDIT",DUZ))) Q
;
FILE K DD,DO I '$D(^DGCR(399,IBIFN,"R",0)) S ^(0)="^399.046^"
S DIC(0)="MN",DA(1)=IBIFN,DIC="^DGCR(399,"_DA(1)_",""R"",",DIE=DIC,DIC("DR")=".02////"_DUZ S X="NOW",%DT="T" D ^%DT S X=Y D FILE^DICN G:Y<1 END S DGIFN=+Y
Q
;
EDIT N DGIFN G RTN:IBAC=6 D ^IBCSCU,^IBCSC1 I '$T K IBIFN Q
;
RTN I '$D(^XUSEC("IB AUTHORIZE",DUZ))!('$D(IBIFN)) K IBIFN Q
D EDITS^IBCB2 I IBQUIT K IBIFN Q
RTN1 W !!,"WANT TO RETURN BILL TO A/R AT THIS TIME" S %=2 D YN^DICN Q:%=1 I %=-1!(%=2) K IBIFN Q
I '% W !?4,"YES - To set the status to Returned",!?4,"No - To take no action" G RTN1
Q
;
;store sending data at this point
SEND S DA(1)=IBIFN,DA=DGIFN,(DIC,DIE)="^DGCR(399,"_DA(1)_",""R"",",DR=".03;.04" D ^DIE
I '$P(^DGCR(399,IBIFN,"R",DGIFN,0),"^",4) K IBIFN Q
;
W !,"Passing completed Bill to Accounts Receivable. Bill is no longer editable."
I $P(^DGCR(399,IBIFN,"S"),"^",9) D GVAR^IBCBB,ARRAY^IBCBB1,^PRCASVC6 D REL^PRCASVC:PRCASV("OKAY") I 'PRCASV("OKAY") D FXERR1^IBCB2 K IBIFN Q
W !,"Completed Bill Successfully sent to Accounts Receivable."
Q
;
PRINT I $D(IBIFN) S IBVIEW=1 D 4^IBCB1 Q
Q
;
END L K IBNDS,IBDISP,IBER,IBNDI1,IBV,DGIFN,IBVIEW,IBIFN,DFN,IBAC,PRCASV D KILL^IBCMENU
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBCRTN" D T1^%ZOSV ;stop rt clock
Q
IBCRTN ;ALB/AAS - EDIT BILLS RETURNED FROM AR (NEW) ; 23-MAY-90
+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 DGCRTN
+5 ;
EN1 ;
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="EN1^IBCRTN" D T1^%ZOSV ;stop rt clock
+3 ;S XRTL=$ZU(0),XRTN="EN1^IBCRTN-1" D T0^%ZOSV ;start rt clock
+4 ;
+5 DO END
SET IBAC=5
SET IBV=0
DO LOOK
IF '$DATA(IBIFN)
GOTO END
DO EDIT
IF $DATA(IBIFN)
DO SEND
IF $DATA(IBIFN)
DO PRINT
LOCK
GOTO EN1
+6 QUIT
+7 ;
EN2 ;
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="EN2^IBCRTN" D T1^%ZOSV ;stop rt clock
+3 ;S XRTL=$ZU(0),XRTN="EN2^IBCRTN-1" D T0^%ZOSV ;start rt clock
+4 ;
+5 DO END
SET IBAC=6
SET IBV=1
DO LOOK
IF '$DATA(IBIFN)
GOTO END
DO RTN
IF $DATA(IBIFN)
DO SEND
IF $DATA(IBIFN)
DO PRINT
LOCK
GOTO EN2
+6 QUIT
+7 ;
LOOK SET DIC="^DGCR(399,"
SET DIC(0)="AEQMZ"
SET DIC("S")="I $S($P(^(0),U,13)=7:0,+$$RETN^PRCAFN(Y):1,1:0)"
DO ^DIC
KILL DIC
IF +Y<1
QUIT
+1 SET IBIFN=+Y
SET DFN=$PIECE(Y(0),"^",2)
+2 LOCK ^DGCR(399,IBIFN):1
IF '$TEST
WRITE !,"Already being edited by another user"
KILL IBIFN,DFN
QUIT
+3 IF '$PIECE(^DGCR(399,IBIFN,"S"),"^",9)!('$DATA(^XUSEC("IB EDIT",DUZ)))
QUIT
+4 ;
FILE KILL DD,DO
IF '$DATA(^DGCR(399,IBIFN,"R",0))
SET ^(0)="^399.046^"
+1 SET DIC(0)="MN"
SET DA(1)=IBIFN
SET DIC="^DGCR(399,"_DA(1)_",""R"","
SET DIE=DIC
SET DIC("DR")=".02////"_DUZ
SET X="NOW"
SET %DT="T"
DO ^%DT
SET X=Y
DO FILE^DICN
IF Y<1
GOTO END
SET DGIFN=+Y
+2 QUIT
+3 ;
EDIT NEW DGIFN
IF IBAC=6
GOTO RTN
DO ^IBCSCU
DO ^IBCSC1
IF '$TEST
KILL IBIFN
QUIT
+1 ;
RTN IF '$DATA(^XUSEC("IB AUTHORIZE",DUZ))!('$DATA(IBIFN))
KILL IBIFN
QUIT
+1 DO EDITS^IBCB2
IF IBQUIT
KILL IBIFN
QUIT
RTN1 WRITE !!,"WANT TO RETURN BILL TO A/R AT THIS TIME"
SET %=2
DO YN^DICN
IF %=1
QUIT
IF %=-1!(%=2)
KILL IBIFN
QUIT
+1 IF '%
WRITE !?4,"YES - To set the status to Returned",!?4,"No - To take no action"
GOTO RTN1
+2 QUIT
+3 ;
+4 ;store sending data at this point
SEND SET DA(1)=IBIFN
SET DA=DGIFN
SET (DIC,DIE)="^DGCR(399,"_DA(1)_",""R"","
SET DR=".03;.04"
DO ^DIE
+1 IF '$PIECE(^DGCR(399,IBIFN,"R",DGIFN,0),"^",4)
KILL IBIFN
QUIT
+2 ;
+3 WRITE !,"Passing completed Bill to Accounts Receivable. Bill is no longer editable."
+4 IF $PIECE(^DGCR(399,IBIFN,"S"),"^",9)
DO GVAR^IBCBB
DO ARRAY^IBCBB1
DO ^PRCASVC6
IF PRCASV("OKAY")
DO REL^PRCASVC
IF 'PRCASV("OKAY")
DO FXERR1^IBCB2
KILL IBIFN
QUIT
+5 WRITE !,"Completed Bill Successfully sent to Accounts Receivable."
+6 QUIT
+7 ;
PRINT IF $DATA(IBIFN)
SET IBVIEW=1
DO 4^IBCB1
QUIT
+1 QUIT
+2 ;
END LOCK
KILL IBNDS,IBDISP,IBER,IBNDI1,IBV,DGIFN,IBVIEW,IBIFN,DFN,IBAC,PRCASV
DO KILL^IBCMENU
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCRTN" D T1^%ZOSV ;stop rt clock
+3 QUIT
