source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRPR.m@ 1000

Last change on this file since 1000 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1IBTRPR ;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% ;
6EN ; -- main entry point for IBT EDIT PENDING REVIEW from menu's
7 I '$D(DT) D DT^DICRW
8 K XQORS,VALMQUIT,VALMEVL,IBTRN,IBTRV,IBTRC,IBTRD,DFN,IBCNS,IBFASTXT
9 W !!,"Pending Reviews Option",!
10 D DATE^IBTRPR0
11 D SORT^IBTRPR0
12 S IBTWHO="A" I IBSORT="A" D WHOSE^IBTRPR0
13 S IBTPRT="B",VAUTD=1 I IBSORT="T" D TYPE^IBTRPR0
14 I $D(VALMQUIT) G ENQ
15 I '$G(IBTRPRF) S IBTRPRF=12
16 D EN^VALM("IBT EDIT PENDING REVIEW")
17ENQ 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
18 K IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
19 K IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
20 D KVAR^VADPT
21 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
22 Q
23 ;
24HDR ; -- header code
25 S VALMHDR(1)="List of PENDING WORK for: "_$$DAT1^IBOUTL(IBTPBDT,"2P")_" to "_$$DAT1^IBOUTL(IBTPEDT,"2P")
26 S VALMHDR(2)=""
27 Q
28 ;
29INIT ; -- init variables and list array
30 S U="^",VALMCNT=0,VALMBG=1
31 K ^TMP("IBTRPR",$J),^TMP("IBTRPRDX",$J)
32 K I,X,XQORNOD,DA,DR,DNM,DQ
33 ;
34 ; -- run the scheduled admissions list
35 D ^IBTRKR2 W !!,"Building your work list..."
36 D BLD
37 Q
38 ;
39BLD ; -- build list
40 ; 1. build pending hospital reviews
41 ; 2. build pending insurance reviews
42 ;
43 K ^TMP("IBTRPR",$J),^TMP("IBTRPRDX",$J),^TMP("IBSRT",$J),^TMP("IBSRT1",$J)
44 N IBI,J
45 S (IBCNT,VALMCNT)=0,IBI=""
46 I '$D(IBTPRT) S IBTRPT="B"
47 I '$D(IBTWHO) S IBTWHO="A"
48 I '$G(IBTRPRF) S IBTRPRF=12
49 I IBTRPRF<10 S X=$S(IBTRPRF=1:"IBTRPR HR MENU",IBTRPRF=2:"IBTRPR IR MENU",1:"IBTRPR MENU") D PROT(X)
50 D:IBTRPRF[1 1^IBTRPR01
51 D:IBTRPRF[2 2^IBTRPR01
52 ;
53 ; -- go through sorted list
54 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
55 .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
56 ..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
57 ...S IBDATA=^TMP("IBSRT",$J,IBDV,TYPE,IBI,IBJ,IBK,IBL)
58 ...S IBTRN=+IBDATA,ENTRY=$P(IBDATA,"^",2)
59 ...S IBDATE=$P(IBDATA,"^",3),DFN=$P(IBDATA,"^",4),IBWARD=$P(IBDATA,"^",5)
60 ...S IBSTATUS=$P(IBDATA,"^",6),IBREV=$P(IBDATA,"^",7)
61 ...S IBASSIGN=$P(IBDATA,"^",9),IBNEXT=$P(IBDATA,"^",10)
62 ...S IBFLAG=$O(^TMP("IBSRT1",$J,DFN,"")),IBFLAG=$O(^TMP("IBSRT1",$J,DFN,IBFLAG)) I IBFLAG'="" S IBFLAG="+"
63 ...S FILE=$P(IBDATA,"^",8)
64 ...D PID^VADPT
65 ...S IBCNT=IBCNT+1 D BLD1^IBTRPR0
66 ...Q
67 K ^TMP("IBSRT",$J),^TMP("IBSRT1",$J)
68 Q
69 ;
70HELP ; -- help code
71 S X="?" D DISP^XQORM1 W !!
72 Q
73 ;
74EXIT ; -- exit code
75 K ^TMP("IBTRPR",$J),^TMP("IBTRPRDX",$J)
76 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
77 D FULL^VALM1,CLEAN^VALM10
78 Q
79 ;
80PROT(X) ; -- set protocol menu
81 N DIC,Y
82 I $G(X)'="" S DIC=101,DIC(0)="N" D ^DIC
83 I +Y S VALM("PROTOCOL")=+Y_";ORD(101,"
84PROTQ Q
Note: See TracBrowser for help on using the repository browser.