IBTRPR1 ;ALB/AAS - CLAIMS TRACKING - PENDING WORK ACTIONS ; 9-AUG-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% G EN^IBTRPR
;
NX(IBTMPNM) ; -- Go to next template
; -- Input template name
N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))
.S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
.I IBTMPNM["REVIEW EDITOR"!(IBTMPNM["COMMUNICATIONS EDITOR") D
..I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3),IBTMPNM="IBT REVIEW EDITOR"
..I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3),IBTMPNM="IBT COMMUNICATIONS EDITOR"
.D EN^VALM(IBTMPNM)
.K IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
.K IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
.D KVAR^VADPT
.Q
I '$D(IBFASTXT) D BLD^IBTRPR
S VALMBCK="R"
Q
;
CD ; -- Change Date range
S VALMB=IBTPBDT D RANGE^VALM11
I $S('VALMBEG:1,IBTPBDT'=VALMBEG:0,1:IBTPEDT=VALMEND) W !!,"Date range was not changed." D PAUSE^VALM1 S VALMBCK="" G CDQ
S IBTPBDT=VALMBEG,IBTPEDT=VALMEND
D BLD^IBTRPR
D HDR^IBTRPR S VALMBG=1
CDQ K VALMB,VALMBEG,VALMEND
S VALMBCK="R"
Q
;
QE ; -- Quick Edit Entry
N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))
.S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
.I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3) D QE1^IBTRV1 Q
.I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3) D QE1^IBTRC1 Q
.D EN^VALM(IBTMPNM)
.Q
D BLD^IBTRPR
S VALMBCK="R"
Q
D BLD^IBTRPR
S VALMBCK="R"
Q
;
VE ; -- View Edit entry
N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))
.S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
.I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3),IBTMPNM="IBT EXPAND/EDIT REVIEW"
.I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3),IBTMPNM="IBT EXPAND/EDIT COMMUNICATIONS"
.D EN^VALM(IBTMPNM)
.Q
D BLD^IBTRPR
S VALMBCK="R"
Q
;
SC ; -- Status Change
N VALMY,I,J,IBT,IBXXT,IBTEMP
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXXT=0 F S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT D
.S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXXT,0))))
.S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
.S IBTEMP="[IBT STATUS CHANGE]"
.I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3) D EDIT^IBTRVD1(IBTEMP,1) Q
.I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3) D EDIT^IBTRCD1(IBTEMP,1) Q
.Q
D BLD^IBTRPR
S VALMBCK="R"
Q
;
RL ; -- Remove from list
; Just delete Next review date
N VALMY,I,J,IBT,IBXXT,IBTEMP
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXXT=0 F S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT D
.S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXXT,0))))
.S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
.S IBTEMP="[IBT REMOVE NEXT REVIEW]"
.W !!,"Removing Next Review Date from entry #",IBXXT
.I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3) D EDIT^IBTRVD1(IBTEMP,1) Q
.I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3) D EDIT^IBTRCD1(IBTEMP,1) Q
.Q
D BLD^IBTRPR
S VALMBCK="R"
Q
;
SHOWSC ; -- show sc conditions
N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))
.S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
.D SHOWSC^IBTRC1
.Q
S VALMBCK="R"
Q
;
PW ; -- Print worksheet
N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))
.S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
.D RW^IBTRC4
.Q
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRPR1 4184 printed Oct 16, 2024@18:29:28 Page 2
IBTRPR1 ;ALB/AAS - CLAIMS TRACKING - PENDING WORK ACTIONS ; 9-AUG-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% GOTO EN^IBTRPR
+1 ;
NX(IBTMPNM) ; -- Go to next template
+1 ; -- Input template name
+2 NEW I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+5 SET IBT=$GET(^TMP("IBTRPRDX",$JOB,+$ORDER(^TMP("IBTRPR",$JOB,"IDX",IBXX,0))))
+6 SET IBTRN=$PIECE(IBT,"^",4)
SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)
+7 IF IBTMPNM["REVIEW EDITOR"!(IBTMPNM["COMMUNICATIONS EDITOR")
Begin DoDot:2
+8 IF $PIECE(IBT,"^",2)=356.1
SET IBTRV=$PIECE(IBT,"^",3)
SET IBTMPNM="IBT REVIEW EDITOR"
+9 IF $PIECE(IBT,"^",2)=356.2
SET IBTRC=$PIECE(IBT,"^",3)
SET IBTMPNM="IBT COMMUNICATIONS EDITOR"
End DoDot:2
+10 DO EN^VALM(IBTMPNM)
+11 KILL IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
+12 KILL IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
+13 DO KVAR^VADPT
+14 QUIT
End DoDot:1
+15 IF '$DATA(IBFASTXT)
DO BLD^IBTRPR
+16 SET VALMBCK="R"
+17 QUIT
+18 ;
CD ; -- Change Date range
+1 SET VALMB=IBTPBDT
DO RANGE^VALM11
+2 IF $SELECT('VALMBEG:1,IBTPBDT'=VALMBEG:0,1:IBTPEDT=VALMEND)
WRITE !!,"Date range was not changed."
DO PAUSE^VALM1
SET VALMBCK=""
GOTO CDQ
+3 SET IBTPBDT=VALMBEG
SET IBTPEDT=VALMEND
+4 DO BLD^IBTRPR
+5 DO HDR^IBTRPR
SET VALMBG=1
CDQ KILL VALMB,VALMBEG,VALMEND
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
QE ; -- Quick Edit Entry
+1 NEW I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
+2 DO EN^VALM2($GET(XQORNOD(0)))
+3 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+4 SET IBT=$GET(^TMP("IBTRPRDX",$JOB,+$ORDER(^TMP("IBTRPR",$JOB,"IDX",IBXX,0))))
+5 SET IBTRN=$PIECE(IBT,"^",4)
SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)
+6 IF $PIECE(IBT,"^",2)=356.1
SET IBTRV=$PIECE(IBT,"^",3)
DO QE1^IBTRV1
QUIT
+7 IF $PIECE(IBT,"^",2)=356.2
SET IBTRC=$PIECE(IBT,"^",3)
DO QE1^IBTRC1
QUIT
+8 DO EN^VALM(IBTMPNM)
+9 QUIT
End DoDot:1
+10 DO BLD^IBTRPR
+11 SET VALMBCK="R"
+12 QUIT
+13 DO BLD^IBTRPR
+14 SET VALMBCK="R"
+15 QUIT
+16 ;
VE ; -- View Edit entry
+1 NEW I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
+2 DO EN^VALM2($GET(XQORNOD(0)))
+3 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+4 SET IBT=$GET(^TMP("IBTRPRDX",$JOB,+$ORDER(^TMP("IBTRPR",$JOB,"IDX",IBXX,0))))
+5 SET IBTRN=$PIECE(IBT,"^",4)
SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)
+6 IF $PIECE(IBT,"^",2)=356.1
SET IBTRV=$PIECE(IBT,"^",3)
SET IBTMPNM="IBT EXPAND/EDIT REVIEW"
+7 IF $PIECE(IBT,"^",2)=356.2
SET IBTRC=$PIECE(IBT,"^",3)
SET IBTMPNM="IBT EXPAND/EDIT COMMUNICATIONS"
+8 DO EN^VALM(IBTMPNM)
+9 QUIT
End DoDot:1
+10 DO BLD^IBTRPR
+11 SET VALMBCK="R"
+12 QUIT
+13 ;
SC ; -- Status Change
+1 NEW VALMY,I,J,IBT,IBXXT,IBTEMP
+2 DO EN^VALM2($GET(XQORNOD(0)))
+3 IF $DATA(VALMY)
SET IBXXT=0
FOR
SET IBXXT=$ORDER(VALMY(IBXXT))
if 'IBXXT
QUIT
Begin DoDot:1
+4 SET IBT=$GET(^TMP("IBTRPRDX",$JOB,+$ORDER(^TMP("IBTRPR",$JOB,"IDX",IBXXT,0))))
+5 SET IBTRN=$PIECE(IBT,"^",4)
SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)
+6 SET IBTEMP="[IBT STATUS CHANGE]"
+7 IF $PIECE(IBT,"^",2)=356.1
SET IBTRV=$PIECE(IBT,"^",3)
DO EDIT^IBTRVD1(IBTEMP,1)
QUIT
+8 IF $PIECE(IBT,"^",2)=356.2
SET IBTRC=$PIECE(IBT,"^",3)
DO EDIT^IBTRCD1(IBTEMP,1)
QUIT
+9 QUIT
End DoDot:1
+10 DO BLD^IBTRPR
+11 SET VALMBCK="R"
+12 QUIT
+13 ;
RL ; -- Remove from list
+1 ; Just delete Next review date
+2 NEW VALMY,I,J,IBT,IBXXT,IBTEMP
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET IBXXT=0
FOR
SET IBXXT=$ORDER(VALMY(IBXXT))
if 'IBXXT
QUIT
Begin DoDot:1
+5 SET IBT=$GET(^TMP("IBTRPRDX",$JOB,+$ORDER(^TMP("IBTRPR",$JOB,"IDX",IBXXT,0))))
+6 SET IBTRN=$PIECE(IBT,"^",4)
SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)
+7 SET IBTEMP="[IBT REMOVE NEXT REVIEW]"
+8 WRITE !!,"Removing Next Review Date from entry #",IBXXT
+9 IF $PIECE(IBT,"^",2)=356.1
SET IBTRV=$PIECE(IBT,"^",3)
DO EDIT^IBTRVD1(IBTEMP,1)
QUIT
+10 IF $PIECE(IBT,"^",2)=356.2
SET IBTRC=$PIECE(IBT,"^",3)
DO EDIT^IBTRCD1(IBTEMP,1)
QUIT
+11 QUIT
End DoDot:1
+12 DO BLD^IBTRPR
+13 SET VALMBCK="R"
+14 QUIT
+15 ;
SHOWSC ; -- show sc conditions
+1 NEW I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
+2 DO EN^VALM2($GET(XQORNOD(0)))
+3 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+4 SET IBT=$GET(^TMP("IBTRPRDX",$JOB,+$ORDER(^TMP("IBTRPR",$JOB,"IDX",IBXX,0))))
+5 SET IBTRN=$PIECE(IBT,"^",4)
SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)
+6 DO SHOWSC^IBTRC1
+7 QUIT
End DoDot:1
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
PW ; -- Print worksheet
+1 NEW I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
+2 DO EN^VALM2($GET(XQORNOD(0)))
+3 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+4 SET IBT=$GET(^TMP("IBTRPRDX",$JOB,+$ORDER(^TMP("IBTRPR",$JOB,"IDX",IBXX,0))))
+5 SET IBTRN=$PIECE(IBT,"^",4)
SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)
+6 DO RW^IBTRC4
+7 QUIT
End DoDot:1
+8 SET VALMBCK="R"
+9 QUIT
