- 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
- 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
