| 1 | IBTRPR0 ;ALB/AAS - CLAIMS TRACKING - PENDING WORK SCREEN ; 22-JUL-1993
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | % G ^IBTRPR
|
|---|
| 6 | ;
|
|---|
| 7 | BLD1 N IBI,IBJ,IBL,IBK
|
|---|
| 8 | S X=""
|
|---|
| 9 | S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
|
|---|
| 10 | S X=$$SETFLD^VALM1(TYPE,X,"TYPE")
|
|---|
| 11 | S X=$$SETFLD^VALM1($P($G(^IBE(356.11,+$G(IBREV),0)),"^",3),X,"REVIEW")
|
|---|
| 12 | S X=$$SETFLD^VALM1($$DAT1^IBOUTL(IBDATE,"2P"),X,"DATE")
|
|---|
| 13 | S X=$$SETFLD^VALM1(IBFLAG_$P(^DPT(+DFN,0),"^"),X,"PATIENT")
|
|---|
| 14 | S X=$$SETFLD^VALM1(VA("BID"),X,"ID")
|
|---|
| 15 | S X=$$SETFLD^VALM1(IBSTATUS,X,"STATUS")
|
|---|
| 16 | S X=$$SETFLD^VALM1(IBNEXT,X,"NEXT")
|
|---|
| 17 | S X=$$SETFLD^VALM1(IBWARD,X,"WARD")
|
|---|
| 18 | S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(^IBT(356,+IBTRN,0),U,6),"2P"),X,"EV DATE")
|
|---|
| 19 | S X=$$SETFLD^VALM1($P($G(^IBE(356.6,+$P(^IBT(356,+IBTRN,0),U,18),0)),U,2),X,"EVENT")
|
|---|
| 20 | S X=$$SETFLD^VALM1(IBASSIGN,X,"ASSIGNED TO")
|
|---|
| 21 | W "."
|
|---|
| 22 | D SET(X)
|
|---|
| 23 | I IBFLAG="+" S VALMSG="'+' indicates both Hosp. and Ins. Reviews on List"
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | SET(X) ; -- set arrays
|
|---|
| 27 | S VALMCNT=VALMCNT+1
|
|---|
| 28 | S ^TMP("IBTRPR",$J,VALMCNT,0)=X
|
|---|
| 29 | S ^TMP("IBTRPR",$J,"IDX",VALMCNT,IBCNT)=""
|
|---|
| 30 | S ^TMP("IBTRPRDX",$J,IBCNT)=VALMCNT_"^"_FILE_"^"_ENTRY_"^"_IBTRN
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | DATE ; -- compute initial date range
|
|---|
| 34 | ;S IBTPEDT=$$FMADD^XLFDT(DT,27) ; initial end date 1 week in future
|
|---|
| 35 | S IBTPEDT=DT ; initial end date = today
|
|---|
| 36 | S IBTPBDT=$$FMADD^XLFDT(DT,-7) ; show only last weeks pending work.
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | SORT ; -- ask how they want it sorted
|
|---|
| 40 | N DIR
|
|---|
| 41 | S DIR(0)="SOBA^A:ASSIGNED TO;D:DUE DATE;P:PATIENT;T:TYPE REVIEW;W:WARD"
|
|---|
| 42 | S DIR("A")="Sort Reviews By [A]ssigned to [D]ue date [P]atient [T]ype [W]ard: "
|
|---|
| 43 | S DIR("B")="P"
|
|---|
| 44 | S DIR("?",1)="Select how you would like your pending reviews sorted. The choices are by"
|
|---|
| 45 | S DIR("?",2)="who they are Assigned to, by Due date, by Patient, by Type of review, or"
|
|---|
| 46 | S DIR("?",3)="by current Ward of the patient."
|
|---|
| 47 | S DIR("?",4)=" ",DIR("?")="The default is by patient. Normally if sorted by other than patient, the list will be sorted within your choice by patient."
|
|---|
| 48 | D ^DIR K DIR
|
|---|
| 49 | S IBSORT=Y I "ADPTW"'[Y!($D(DIRUT)) S VALMQUIT=""
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | TYPE ; -- if by type, ask which type of reviews
|
|---|
| 53 | W !
|
|---|
| 54 | N DIR
|
|---|
| 55 | S DIR(0)="SOBA^A:ADMISSION REVIEWS;C:CONTINUED STAY REVIEWS;B:OTH"
|
|---|
| 56 | S DIR("A")="Print Pending [A]dmission Reviews [C]ontinued Stay Reviews [B]oth: "
|
|---|
| 57 | S DIR("B")="B"
|
|---|
| 58 | S DIR("?")="If you only want to list your pending Admission Reviews (pre-certs, urgent admissions etc.) enter 'A'. If you want to list only your pending Continued Stay Reviews enter 'C', or enter 'B' to see all pending reviews."
|
|---|
| 59 | D ^DIR K DIR
|
|---|
| 60 | S IBTPRT=Y I "ACB"'[Y!($D(DIRUT)) S VALMQUIT=""
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | WHOSE ; -- if by assigned to, ask assigned to who
|
|---|
| 64 | W !
|
|---|
| 65 | N DIR
|
|---|
| 66 | S DIR(0)="SOBA^Y:YOUR OWN;U:UNASSIGNED PLUS YOUR OWN;A:ALL"
|
|---|
| 67 | S DIR("A")="Print [Y]our own [U]nassigned plus your own [A]ll: "
|
|---|
| 68 | S DIR("B")="Y"
|
|---|
| 69 | S DIR("?")="If you only want to list Your own pending Reviews enter 'Y', if you want to list unassigned reviews plus your own pending Reviews enter 'U', or enter 'A' to see all pending reviews."
|
|---|
| 70 | D ^DIR K DIR
|
|---|
| 71 | S IBTWHO=Y I "AUY"'[Y!($D(DIRUT)) S VALMQUIT=""
|
|---|
| 72 | Q
|
|---|
