IBTRPR ;ALB/AAS - CLAIMS TRACKING - PENDING WORK SCREEN ; 22-JUL-1993
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% ;
EN ; -- main entry point for IBT EDIT PENDING REVIEW from menu's
I '$D(DT) D DT^DICRW
K XQORS,VALMQUIT,VALMEVL,IBTRN,IBTRV,IBTRC,IBTRD,DFN,IBCNS,IBFASTXT
W !!,"Pending Reviews Option",!
D DATE^IBTRPR0
D SORT^IBTRPR0
S IBTWHO="A" I IBSORT="A" D WHOSE^IBTRPR0
S IBTPRT="B",VAUTD=1 I IBSORT="T" D TYPE^IBTRPR0
I $D(VALMQUIT) G ENQ
I '$G(IBTRPRF) S IBTRPRF=12
D EN^VALM("IBT EDIT PENDING REVIEW")
ENQ K IBFASTXT,VALMQUIT,IBSORT,IBTPBDT,IBTPEDT,DIR,DIRUT,DUOUT,X,Y,IBTRN,IBTRV,IBTRC,IBTRD,DFN,IBCNS,XQORS,IBTRPRF,IBQUIT,IBTWHO,IBTPRT,DIC,DR,DIE,DA,I,J
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
K IBFASTXT,IBSCP,IBOTB,XQORS,VALMEVL,DFN,IBTRN,IBTRV,IBTRC,IBTRD,IBCNS,IBCDFN,VA,VAERR,VA200,IBCNT,IBI,IBTBDT,IBTEDT,IBUR,IBTRPRF,VAEL,VAIN,PRECERT,IBAMNT,IBDGCR,IBDGCRU1,IBETYP,IBETYPD,IBLCNT,IBTEXT,IBTRND,X,Y,Z,IBTMPNM
Q
;
HDR ; -- header code
S VALMHDR(1)="List of PENDING WORK for: "_$$DAT1^IBOUTL(IBTPBDT,"2P")_" to "_$$DAT1^IBOUTL(IBTPEDT,"2P")
S VALMHDR(2)=""
Q
;
INIT ; -- init variables and list array
S U="^",VALMCNT=0,VALMBG=1
K ^TMP("IBTRPR",$J),^TMP("IBTRPRDX",$J)
K I,X,XQORNOD,DA,DR,DNM,DQ
;
; -- run the scheduled admissions list
D ^IBTRKR2 W !!,"Building your work list..."
D BLD
Q
;
BLD ; -- build list
; 1. build pending hospital reviews
; 2. build pending insurance reviews
;
K ^TMP("IBTRPR",$J),^TMP("IBTRPRDX",$J),^TMP("IBSRT",$J),^TMP("IBSRT1",$J)
N IBI,J
S (IBCNT,VALMCNT)=0,IBI=""
I '$D(IBTPRT) S IBTRPT="B"
I '$D(IBTWHO) S IBTWHO="A"
I '$G(IBTRPRF) S IBTRPRF=12
I IBTRPRF<10 S X=$S(IBTRPRF=1:"IBTRPR HR MENU",IBTRPRF=2:"IBTRPR IR MENU",1:"IBTRPR MENU") D PROT(X)
D:IBTRPRF[1 1^IBTRPR01
D:IBTRPRF[2 2^IBTRPR01
;
; -- go through sorted list
S IBDV="" F S IBDV=$O(^TMP("IBSRT",$J,IBDV)) Q:IBDV="" S TYPE="" F S TYPE=$O(^TMP("IBSRT",$J,IBDV,TYPE)) Q:TYPE="" D
.S IBI="" F S IBI=$O(^TMP("IBSRT",$J,IBDV,TYPE,IBI)) Q:IBI="" S IBJ="" F S IBJ=$O(^TMP("IBSRT",$J,IBDV,TYPE,IBI,IBJ)) Q:IBJ="" D
..S IBK="" F S IBK=$O(^TMP("IBSRT",$J,IBDV,TYPE,IBI,IBJ,IBK)) Q:IBK="" S IBL="" F S IBL=$O(^TMP("IBSRT",$J,IBDV,TYPE,IBI,IBJ,IBK,IBL)) Q:IBL="" D
...S IBDATA=^TMP("IBSRT",$J,IBDV,TYPE,IBI,IBJ,IBK,IBL)
...S IBTRN=+IBDATA,ENTRY=$P(IBDATA,"^",2)
...S IBDATE=$P(IBDATA,"^",3),DFN=$P(IBDATA,"^",4),IBWARD=$P(IBDATA,"^",5)
...S IBSTATUS=$P(IBDATA,"^",6),IBREV=$P(IBDATA,"^",7)
...S IBASSIGN=$P(IBDATA,"^",9),IBNEXT=$P(IBDATA,"^",10)
...S IBFLAG=$O(^TMP("IBSRT1",$J,DFN,"")),IBFLAG=$O(^TMP("IBSRT1",$J,DFN,IBFLAG)) I IBFLAG'="" S IBFLAG="+"
...S FILE=$P(IBDATA,"^",8)
...D PID^VADPT
...S IBCNT=IBCNT+1 D BLD1^IBTRPR0
...Q
K ^TMP("IBSRT",$J),^TMP("IBSRT1",$J)
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBTRPR",$J),^TMP("IBTRPRDX",$J)
K I,J,X,Y,ENTRY,FILE,IBDATE,IBJ,IBNEXT,IBREV,IBSTATUS,IBTPEDT,IBTPBDT,IBTRC,IBTRN,IBTRV,TYPE,VA,VAERR,IBASSIGN,IBCNT,IBDATA,IBFLAG,IBK,IBL,IBSORT,IBWARD,IBTSORT
D FULL^VALM1,CLEAN^VALM10
Q
;
PROT(X) ; -- set protocol menu
N DIC,Y
I $G(X)'="" S DIC=101,DIC(0)="N" D ^DIC
I +Y S VALM("PROTOCOL")=+Y_";ORD(101,"
PROTQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRPR 3548 printed Oct 16, 2024@18:29:25 Page 2
IBTRPR ;ALB/AAS - CLAIMS TRACKING - PENDING WORK SCREEN ; 22-JUL-1993
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% ;
EN ; -- main entry point for IBT EDIT PENDING REVIEW from menu's
+1 IF '$DATA(DT)
DO DT^DICRW
+2 KILL XQORS,VALMQUIT,VALMEVL,IBTRN,IBTRV,IBTRC,IBTRD,DFN,IBCNS,IBFASTXT
+3 WRITE !!,"Pending Reviews Option",!
+4 DO DATE^IBTRPR0
+5 DO SORT^IBTRPR0
+6 SET IBTWHO="A"
IF IBSORT="A"
DO WHOSE^IBTRPR0
+7 SET IBTPRT="B"
SET VAUTD=1
IF IBSORT="T"
DO TYPE^IBTRPR0
+8 IF $DATA(VALMQUIT)
GOTO ENQ
+9 IF '$GET(IBTRPRF)
SET IBTRPRF=12
+10 DO EN^VALM("IBT EDIT PENDING REVIEW")
ENQ KILL IBFASTXT,VALMQUIT,IBSORT,IBTPBDT,IBTPEDT,DIR,DIRUT,DUOUT,X,Y,IBTRN,IBTRV,IBTRC,IBTRD,DFN,IBCNS,XQORS,IBTRPRF,IBQUIT,IBTWHO,IBTPRT,DIC,DR,DIE,DA,I,J
+1 KILL IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
+2 KILL IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
+3 DO KVAR^VADPT
+4 KILL IBFASTXT,IBSCP,IBOTB,XQORS,VALMEVL,DFN,IBTRN,IBTRV,IBTRC,IBTRD,IBCNS,IBCDFN,VA,VAERR,VA200,IBCNT,IBI,IBTBDT,IBTEDT,IBUR,IBTRPRF,VAEL,VAIN,PRECERT,IBAMNT,IBDGCR,IBDGCRU1,IBETYP,IBETYPD,IBLCNT,IBTEXT,IBTRND,X,Y,Z,IBTMPNM
+5 QUIT
+6 ;
HDR ; -- header code
+1 SET VALMHDR(1)="List of PENDING WORK for: "_$$DAT1^IBOUTL(IBTPBDT,"2P")_" to "_$$DAT1^IBOUTL(IBTPEDT,"2P")
+2 SET VALMHDR(2)=""
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 SET U="^"
SET VALMCNT=0
SET VALMBG=1
+2 KILL ^TMP("IBTRPR",$JOB),^TMP("IBTRPRDX",$JOB)
+3 KILL I,X,XQORNOD,DA,DR,DNM,DQ
+4 ;
+5 ; -- run the scheduled admissions list
+6 DO ^IBTRKR2
WRITE !!,"Building your work list..."
+7 DO BLD
+8 QUIT
+9 ;
BLD ; -- build list
+1 ; 1. build pending hospital reviews
+2 ; 2. build pending insurance reviews
+3 ;
+4 KILL ^TMP("IBTRPR",$JOB),^TMP("IBTRPRDX",$JOB),^TMP("IBSRT",$JOB),^TMP("IBSRT1",$JOB)
+5 NEW IBI,J
+6 SET (IBCNT,VALMCNT)=0
SET IBI=""
+7 IF '$DATA(IBTPRT)
SET IBTRPT="B"
+8 IF '$DATA(IBTWHO)
SET IBTWHO="A"
+9 IF '$GET(IBTRPRF)
SET IBTRPRF=12
+10 IF IBTRPRF<10
SET X=$SELECT(IBTRPRF=1:"IBTRPR HR MENU",IBTRPRF=2:"IBTRPR IR MENU",1:"IBTRPR MENU")
DO PROT(X)
+11 if IBTRPRF[1
DO 1^IBTRPR01
+12 if IBTRPRF[2
DO 2^IBTRPR01
+13 ;
+14 ; -- go through sorted list
+15 SET IBDV=""
FOR
SET IBDV=$ORDER(^TMP("IBSRT",$JOB,IBDV))
if IBDV=""
QUIT
SET TYPE=""
FOR
SET TYPE=$ORDER(^TMP("IBSRT",$JOB,IBDV,TYPE))
if TYPE=""
QUIT
Begin DoDot:1
+16 SET IBI=""
FOR
SET IBI=$ORDER(^TMP("IBSRT",$JOB,IBDV,TYPE,IBI))
if IBI=""
QUIT
SET IBJ=""
FOR
SET IBJ=$ORDER(^TMP("IBSRT",$JOB,IBDV,TYPE,IBI,IBJ))
if IBJ=""
QUIT
Begin DoDot:2
+17 SET IBK=""
FOR
SET IBK=$ORDER(^TMP("IBSRT",$JOB,IBDV,TYPE,IBI,IBJ,IBK))
if IBK=""
QUIT
SET IBL=""
FOR
SET IBL=$ORDER(^TMP("IBSRT",$JOB,IBDV,TYPE,IBI,IBJ,IBK,IBL))
if IBL=""
QUIT
Begin DoDot:3
+18 SET IBDATA=^TMP("IBSRT",$JOB,IBDV,TYPE,IBI,IBJ,IBK,IBL)
+19 SET IBTRN=+IBDATA
SET ENTRY=$PIECE(IBDATA,"^",2)
+20 SET IBDATE=$PIECE(IBDATA,"^",3)
SET DFN=$PIECE(IBDATA,"^",4)
SET IBWARD=$PIECE(IBDATA,"^",5)
+21 SET IBSTATUS=$PIECE(IBDATA,"^",6)
SET IBREV=$PIECE(IBDATA,"^",7)
+22 SET IBASSIGN=$PIECE(IBDATA,"^",9)
SET IBNEXT=$PIECE(IBDATA,"^",10)
+23 SET IBFLAG=$ORDER(^TMP("IBSRT1",$JOB,DFN,""))
SET IBFLAG=$ORDER(^TMP("IBSRT1",$JOB,DFN,IBFLAG))
IF IBFLAG'=""
SET IBFLAG="+"
+24 SET FILE=$PIECE(IBDATA,"^",8)
+25 DO PID^VADPT
+26 SET IBCNT=IBCNT+1
DO BLD1^IBTRPR0
+27 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+28 KILL ^TMP("IBSRT",$JOB),^TMP("IBSRT1",$JOB)
+29 QUIT
+30 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBTRPR",$JOB),^TMP("IBTRPRDX",$JOB)
+2 KILL I,J,X,Y,ENTRY,FILE,IBDATE,IBJ,IBNEXT,IBREV,IBSTATUS,IBTPEDT,IBTPBDT,IBTRC,IBTRN,IBTRV,TYPE,VA,VAERR,IBASSIGN,IBCNT,IBDATA,IBFLAG,IBK,IBL,IBSORT,IBWARD,IBTSORT
+3 DO FULL^VALM1
DO CLEAN^VALM10
+4 QUIT
+5 ;
PROT(X) ; -- set protocol menu
+1 NEW DIC,Y
+2 IF $GET(X)'=""
SET DIC=101
SET DIC(0)="N"
DO ^DIC
+3 IF +Y
SET VALM("PROTOCOL")=+Y_";ORD(101,"
PROTQ QUIT
