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

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

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1IBTRPR1 ;ALB/AAS - CLAIMS TRACKING - PENDING WORK ACTIONS ; 9-AUG-93
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 EN^IBTRPR
6 ;
7NX(IBTMPNM) ; -- Go to next template
8 ; -- Input template name
9 N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
10 D EN^VALM2($G(XQORNOD(0)))
11 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
12 .S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))
13 .S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
14 .I IBTMPNM["REVIEW EDITOR"!(IBTMPNM["COMMUNICATIONS EDITOR") D
15 ..I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3),IBTMPNM="IBT REVIEW EDITOR"
16 ..I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3),IBTMPNM="IBT COMMUNICATIONS EDITOR"
17 .D EN^VALM(IBTMPNM)
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 .Q
22 I '$D(IBFASTXT) D BLD^IBTRPR
23 S VALMBCK="R"
24 Q
25 ;
26CD ; -- Change Date range
27 S VALMB=IBTPBDT D RANGE^VALM11
28 I $S('VALMBEG:1,IBTPBDT'=VALMBEG:0,1:IBTPEDT=VALMEND) W !!,"Date range was not changed." D PAUSE^VALM1 S VALMBCK="" G CDQ
29 S IBTPBDT=VALMBEG,IBTPEDT=VALMEND
30 D BLD^IBTRPR
31 D HDR^IBTRPR S VALMBG=1
32CDQ K VALMB,VALMBEG,VALMEND
33 S VALMBCK="R"
34 Q
35 ;
36QE ; -- Quick Edit Entry
37 N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
38 D EN^VALM2($G(XQORNOD(0)))
39 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
40 .S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))
41 .S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
42 .I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3) D QE1^IBTRV1 Q
43 .I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3) D QE1^IBTRC1 Q
44 .D EN^VALM(IBTMPNM)
45 .Q
46 D BLD^IBTRPR
47 S VALMBCK="R"
48 Q
49 D BLD^IBTRPR
50 S VALMBCK="R"
51 Q
52 ;
53VE ; -- View Edit entry
54 N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
55 D EN^VALM2($G(XQORNOD(0)))
56 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
57 .S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))
58 .S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
59 .I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3),IBTMPNM="IBT EXPAND/EDIT REVIEW"
60 .I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3),IBTMPNM="IBT EXPAND/EDIT COMMUNICATIONS"
61 .D EN^VALM(IBTMPNM)
62 .Q
63 D BLD^IBTRPR
64 S VALMBCK="R"
65 Q
66 ;
67SC ; -- Status Change
68 N VALMY,I,J,IBT,IBXXT,IBTEMP
69 D EN^VALM2($G(XQORNOD(0)))
70 I $D(VALMY) S IBXXT=0 F S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT D
71 .S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXXT,0))))
72 .S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
73 .S IBTEMP="[IBT STATUS CHANGE]"
74 .I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3) D EDIT^IBTRVD1(IBTEMP,1) Q
75 .I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3) D EDIT^IBTRCD1(IBTEMP,1) Q
76 .Q
77 D BLD^IBTRPR
78 S VALMBCK="R"
79 Q
80 ;
81RL ; -- Remove from list
82 ; Just delete Next review date
83 N VALMY,I,J,IBT,IBXXT,IBTEMP
84 D EN^VALM2($G(XQORNOD(0)))
85 I $D(VALMY) S IBXXT=0 F S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT D
86 .S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXXT,0))))
87 .S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
88 .S IBTEMP="[IBT REMOVE NEXT REVIEW]"
89 .W !!,"Removing Next Review Date from entry #",IBXXT
90 .I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3) D EDIT^IBTRVD1(IBTEMP,1) Q
91 .I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3) D EDIT^IBTRCD1(IBTEMP,1) Q
92 .Q
93 D BLD^IBTRPR
94 S VALMBCK="R"
95 Q
96 ;
97SHOWSC ; -- show sc conditions
98 N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
99 D EN^VALM2($G(XQORNOD(0)))
100 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
101 .S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))
102 .S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
103 .D SHOWSC^IBTRC1
104 .Q
105 S VALMBCK="R"
106 Q
107 ;
108PW ; -- Print worksheet
109 N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN
110 D EN^VALM2($G(XQORNOD(0)))
111 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
112 .S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))
113 .S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
114 .D RW^IBTRC4
115 .Q
116 S VALMBCK="R"
117 Q
Note: See TracBrowser for help on using the repository browser.