IBTRPR0.m

IBTRPR0	;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.

	;

%	G ^IBTRPR

	;

BLD1	N IBI,IBJ,IBL,IBK

	S X=""

	S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")

	S X=$$SETFLD^VALM1(TYPE,X,"TYPE")

	S X=$$SETFLD^VALM1($P($G(^IBE(356.11,+$G(IBREV),0)),"^",3),X,"REVIEW")

	S X=$$SETFLD^VALM1($$DAT1^IBOUTL(IBDATE,"2P"),X,"DATE")

	S X=$$SETFLD^VALM1(IBFLAG_$P(^DPT(+DFN,0),"^"),X,"PATIENT")

	S X=$$SETFLD^VALM1(VA("BID"),X,"ID")

	S X=$$SETFLD^VALM1(IBSTATUS,X,"STATUS")

	S X=$$SETFLD^VALM1(IBNEXT,X,"NEXT")

	S X=$$SETFLD^VALM1(IBWARD,X,"WARD")

	S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(^IBT(356,+IBTRN,0),U,6),"2P"),X,"EV DATE")

	S X=$$SETFLD^VALM1($P($G(^IBE(356.6,+$P(^IBT(356,+IBTRN,0),U,18),0)),U,2),X,"EVENT")

	S X=$$SETFLD^VALM1(IBASSIGN,X,"ASSIGNED TO")

	W "."

	D SET(X)

	I IBFLAG="+" S VALMSG="'+' indicates both Hosp. and Ins. Reviews on List"

	Q

	;

SET(X)	; -- set arrays

	S VALMCNT=VALMCNT+1

	S ^TMP("IBTRPR",$J,VALMCNT,0)=X

	S ^TMP("IBTRPR",$J,"IDX",VALMCNT,IBCNT)=""

	S ^TMP("IBTRPRDX",$J,IBCNT)=VALMCNT_"^"_FILE_"^"_ENTRY_"^"_IBTRN

	Q

	;

DATE	; -- compute initial date range

	;S IBTPEDT=$$FMADD^XLFDT(DT,27) ; initial end date 1 week in future

	S IBTPEDT=DT ; initial end date = today

	S IBTPBDT=$$FMADD^XLFDT(DT,-7) ; show only last weeks pending work.

	Q

	;

SORT	; -- ask how they want it sorted

	N DIR

	S DIR(0)="SOBA^A:ASSIGNED TO;D:DUE DATE;P:PATIENT;T:TYPE REVIEW;W:WARD"

	S DIR("A")="Sort Reviews By [A]ssigned to  [D]ue date  [P]atient  [T]ype  [W]ard: "

	S DIR("B")="P"

	S DIR("?",1)="Select how you would like your pending reviews sorted. The choices are by"

	S DIR("?",2)="who they are Assigned to, by Due date, by Patient, by Type of review, or"

	S DIR("?",3)="by current Ward of the patient."

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

	D ^DIR K DIR

	S IBSORT=Y I "ADPTW"'[Y!($D(DIRUT)) S VALMQUIT=""

	Q

	;

TYPE	; -- if by type, ask which type of reviews

	W !

	N DIR

	S DIR(0)="SOBA^A:ADMISSION REVIEWS;C:CONTINUED STAY REVIEWS;B:OTH"

	S DIR("A")="Print Pending [A]dmission Reviews  [C]ontinued Stay Reviews  [B]oth: "

	S DIR("B")="B"

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

	D ^DIR K DIR

	S IBTPRT=Y I "ACB"'[Y!($D(DIRUT)) S VALMQUIT=""

	Q

	;

WHOSE	; -- if by assigned to, ask assigned to who

	W !

	N DIR

	S DIR(0)="SOBA^Y:YOUR OWN;U:UNASSIGNED PLUS YOUR OWN;A:ALL"

	S DIR("A")="Print [Y]our own  [U]nassigned plus your own  [A]ll: "

	S DIR("B")="Y"

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

	D ^DIR K DIR

	S IBTWHO=Y I "AUY"'[Y!($D(DIRUT)) S VALMQUIT=""

	Q

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

%          GOTO ^IBTRPR

 +1       ;

BLD1       NEW IBI,IBJ,IBL,IBK

 +1        SET X=""

 +2        SET X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")

 +3        SET X=$$SETFLD^VALM1(TYPE,X,"TYPE")

 +4        SET X=$$SETFLD^VALM1($PIECE($GET(^IBE(356.11,+$GET(IBREV),0)),"^",3),X,"REVIEW")

 +5        SET X=$$SETFLD^VALM1($$DAT1^IBOUTL(IBDATE,"2P"),X,"DATE")

 +6        SET X=$$SETFLD^VALM1(IBFLAG_$PIECE(^DPT(+DFN,0),"^"),X,"PATIENT")

 +7        SET X=$$SETFLD^VALM1(VA("BID"),X,"ID")

 +8        SET X=$$SETFLD^VALM1(IBSTATUS,X,"STATUS")

 +9        SET X=$$SETFLD^VALM1(IBNEXT,X,"NEXT")

 +10       SET X=$$SETFLD^VALM1(IBWARD,X,"WARD")

 +11       SET X=$$SETFLD^VALM1($$DAT1^IBOUTL($PIECE(^IBT(356,+IBTRN,0),U,6),"2P"),X,"EV DATE")

 +12       SET X=$$SETFLD^VALM1($PIECE($GET(^IBE(356.6,+$PIECE(^IBT(356,+IBTRN,0),U,18),0)),U,2),X,"EVENT")

 +13       SET X=$$SETFLD^VALM1(IBASSIGN,X,"ASSIGNED TO")

 +14       WRITE "."

 +15       DO SET(X)

 +16       IF IBFLAG="+"

               SET VALMSG="'+' indicates both Hosp. and Ins. Reviews on List"

 +17       QUIT 

 +18      ;

SET(X)    ; -- set arrays

 +1        SET VALMCNT=VALMCNT+1

 +2        SET ^TMP("IBTRPR",$JOB,VALMCNT,0)=X

 +3        SET ^TMP("IBTRPR",$JOB,"IDX",VALMCNT,IBCNT)=""

 +4        SET ^TMP("IBTRPRDX",$JOB,IBCNT)=VALMCNT_"^"_FILE_"^"_ENTRY_"^"_IBTRN

 +5        QUIT 

 +6       ;

DATE      ; -- compute initial date range

 +1       ;S IBTPEDT=$$FMADD^XLFDT(DT,27) ; initial end date 1 week in future

 +2       ; initial end date = today

           SET IBTPEDT=DT

 +3       ; show only last weeks pending work.

           SET IBTPBDT=$$FMADD^XLFDT(DT,-7)

 +4        QUIT 

 +5       ;

SORT      ; -- ask how they want it sorted

 +1        NEW DIR

 +2        SET DIR(0)="SOBA^A:ASSIGNED TO;D:DUE DATE;P:PATIENT;T:TYPE REVIEW;W:WARD"

 +3        SET DIR("A")="Sort Reviews By [A]ssigned to  [D]ue date  [P]atient  [T]ype  [W]ard: "

 +4        SET DIR("B")="P"

 +5        SET DIR("?",1)="Select how you would like your pending reviews sorted. The choices are by"

 +6        SET DIR("?",2)="who they are Assigned to, by Due date, by Patient, by Type of review, or"

 +7        SET DIR("?",3)="by current Ward of the patient."

 +8        SET DIR("?",4)=" "

           SET DIR("?")="The default is by patient.  Normally if sorted by other than patient, the list will be sorted within your choice by patient."

 +9        DO ^DIR

           KILL DIR

 +10       SET IBSORT=Y

           IF "ADPTW"'[Y!($DATA(DIRUT))

               SET VALMQUIT=""

 +11       QUIT 

 +12      ;

TYPE      ; -- if by type, ask which type of reviews

 +1        WRITE !

 +2        NEW DIR

 +3        SET DIR(0)="SOBA^A:ADMISSION REVIEWS;C:CONTINUED STAY REVIEWS;B:OTH"

 +4        SET DIR("A")="Print Pending [A]dmission Reviews  [C]ontinued Stay Reviews  [B]oth: "

 +5        SET DIR("B")="B"

 +6        SET 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."

 +7        DO ^DIR

           KILL DIR

 +8        SET IBTPRT=Y

           IF "ACB"'[Y!($DATA(DIRUT))

               SET VALMQUIT=""

 +9        QUIT 

 +10      ;

WHOSE     ; -- if by assigned to, ask assigned to who

 +1        WRITE !

 +2        NEW DIR

 +3        SET DIR(0)="SOBA^Y:YOUR OWN;U:UNASSIGNED PLUS YOUR OWN;A:ALL"

 +4        SET DIR("A")="Print [Y]our own  [U]nassigned plus your own  [A]ll: "

 +5        SET DIR("B")="Y"

 +6        SET 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."

 +7        DO ^DIR

           KILL DIR

 +8        SET IBTWHO=Y

           IF "AUY"'[Y!($DATA(DIRUT))

               SET VALMQUIT=""

 +9        QUIT