source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRE1.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: 4.7 KB
RevLine 
[613]1IBTRE1 ;ALB/AAS - CLAIMS TRACKING - ACTIONS ; 27-JUN-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;**45**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% G EN^IBTRE
6 ;
7NX(IBTMPNM) ; -- Go to next template
8 ; -- Input template name
9 N VALMY,I,J,IBXXT
10 D EN^VALM2($G(XQORNOD(0)))
11 I $D(VALMY) S IBXXT=0 F S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT D
12 .S IBTRN=$P($G(^TMP("IBTREDX",$J,+$O(^TMP("IBTRE",$J,"IDX",IBXXT,0)))),"^",2)
13 .I IBTRN D EN^VALM(IBTMPNM)
14 .K IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
15 .K IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
16 .D KVAR^VADPT
17 .Q
18 I '$D(IBFASTXT) D HDR^IBTRE,BLD^IBTRE
19 S VALMBCK="R"
20 Q
21 ;
22DT ; -- Delete tracking entry
23 I '$D(^XUSEC("IB CLAIMS SUPERVISOR",DUZ)) D SORRY G DTQ
24 N I,J,IBXX,VALMY,DIRUT
25 D EN^VALM2($G(XQORNOD(0)))
26 I $D(VALMY) D FULL^VALM1 S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX!$D(DIRUT) D
27 .S IBTRN=$P($G(^TMP("IBTREDX",$J,$O(^TMP("IBTRE",$J,"IDX",IBXX,0)))),"^",2)
28 .; do some error checking here
29 .I $O(^IBT(356.1,"C",IBTRN,0)) W !!,*7,"There are Hospital Reviews associated with this entry."
30 .I $O(^IBT(356.2,"C",IBTRN,0)) W !!,*7,"There are Insurance Reviews associated with this entry."
31 .W ! S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are You Sure you want to delete entry #"_IBXX
32 .D ^DIR I Y'=1 W !,"Entry #",IBXX," not Deleted!" Q
33 .D DP1
34 .Q
35DTQ D BLD^IBTRE
36 S VALMBCK="R" Q
37 ;
38DP1 ; -- actual deletion
39 N DA,DIC,DIK
40 ;
41 ; -- delete reviews, communications,
42 N IBI,IBCNT
43 S (IBI,IBCNT)=0 F S IBI=$O(^IBT(356.1,"C",IBTRN,IBI)) Q:'IBI D
44 .S DA=IBI,DIK="^IBT(356.1," D ^DIK
45 .S IBCNT=IBCNT+1
46 I IBCNT W !,"Number of Hospital Reviews Deleted: ",IBCNT
47 ;
48 S (IBI,IBCNT)=0 F S IBI=$O(^IBT(356.2,"C",IBTRN,IBI)) Q:'IBI D
49 .S DA=IBI,DIK="^IBT(356.2," D ^DIK
50 .S IBCNT=IBCNT+1
51 I IBCNT W !,"Number of Insurance Reviews Deleted: ",IBCNT
52 ;
53 ; -- delete entry in claims tracking file
54 S DA=IBTRN,DIK="^IBT(356," D ^DIK
55 W !,"Entry ",IBXX," Deleted"
56 Q
57 ;
58CP ; -- change patient
59 N VALMQUIT,IBDFN
60 D FULL^VALM1
61 S IBDFN=DFN D PAT^IBCNSM
62 I $D(VALMQUIT) S DFN=IBDFN
63 S VALMBG=1 D HDR^IBTRE,BLD^IBTRE
64 S VALMBCK="R"
65CPQ K IBDFN
66 Q
67 ;
68QE ; -- Quick edit tracking entry
69 D EN^VALM2($G(XQORNOD(0)))
70 N I,J,IBXX
71 I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
72 .S IBTRN=$P($G(^TMP("IBTREDX",$J,$O(^TMP("IBTRE",$J,"IDX",IBXX,0)))),"^",2)
73 .D QE1
74QEQ S VALMBCK="R"
75 D BLD^IBTRE
76 Q
77 ;
78QE1 N X,Y,DA,DR,DIC,DIE,IBTRTP,IBSEL
79 S DIE="^IBT(356,",DA=IBTRN
80 D EDIT^IBTRED1("[IBT QUICK EDIT]",1)
81 ;
82 I '$D(IBTATRK),$$TRTP^IBTRE1(IBTRN)<3 D ;clinical info only on inpt/outpt
83 .; -- diagnosis edit
84 .D EN^IBTRE3(IBTRN) Q:$G(IBSEL)["^"
85 .;
86 .; -- procedure edit / only inpt. / outpt use add/edit
87 .I $$TRTP^IBTRE1(IBTRN)<2 D EN^IBTRE4(IBTRN) Q:$G(IBSEL)["^"
88 .;
89 .; -- provider edit
90 .D EN^IBTRE5(IBTRN)
91 .;
92 .; -- compute drg
93 .I $P($G(^IBT(356,IBTRN,0)),"^",5) W !! D DRG^IBTRV2(IBTRN)
94 Q
95 ;
96CD ; -- Change Date range
97 D FULL^VALM1
98 S VALMB=IBTBDT D RANGE^VALM11
99 I $S('VALMBEG:1,IBTBDT'=VALMBEG:0,1:IBTEDT=VALMEND) W !!,"Date range was not changed." D PAUSE^VALM1 S VALMBCK="" G CDQ
100 S IBTBDT=VALMBEG,IBTEDT=VALMEND
101 S VALMBG=1 D HDR^IBTRE,BLD^IBTRE
102CDQ K VALMB,VALMBEG,VALMEND
103 S VALMBCK="R"
104 Q
105 ;
106EDIT(IBTEMP) ; -- Edit visit
107 ; -- Input template name
108 N VALMY,I,J,IBXXT
109 D EN^VALM2($G(XQORNOD(0)))
110 ;N I,J,IBXXT
111 I $D(VALMY) S IBXXT=0 F S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT D
112 .S IBTRN=$P($G(^TMP("IBTREDX",$J,+$O(^TMP("IBTRE",$J,"IDX",IBXXT,0)))),"^",2)
113 .I IBTRN D EDIT^IBTRED1(IBTEMP,1)
114 .Q
115 D BLD^IBTRE
116 S VALMBCK="R"
117 Q
118DIAG ; -- diagnosis editing
119 N VALMY,I,J,IBXXT
120 D EN^VALM2($G(XQORNOD(0)))
121 I $D(VALMY) S IBXXT=0 F S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT D
122 .S IBTRN=$P($G(^TMP("IBTREDX",$J,+$O(^TMP("IBTRE",$J,"IDX",IBXXT,0)))),"^",2)
123 .I IBTRN D EN^IBTRE3(IBTRN)
124 .I $P($G(^IBT(356,IBTRN,0)),"^",5) W !! D DRG^IBTRV2(IBTRN)
125 .Q
126 S VALMBCK="R"
127 Q
128 ;
129TRTP(X) ; -- compute tracking type code
130 ; input x = internal entry in 356
131 ; output = code of tracking type from 356.6
132 Q $P($G(^IBE(356.6,+$P($G(^IBT(356,+$G(X),0)),"^",18),0)),"^",3)
133 ;
134SORRY ; -- can't delete, don't have key.
135 W !!,"You do not have access to delete entries. See your application coordinator.",!
136 Q
137 ;
138PU ; -- procedure editing
139 N VALMY,I,J,IBXXT
140 D EN^VALM2($G(XQORNOD(0)))
141 I $D(VALMY) S IBXXT=0 F S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT D
142 .S IBTRN=$P($G(^TMP("IBTREDX",$J,+$O(^TMP("IBTRE",$J,"IDX",IBXXT,0)))),"^",2)
143 .I IBTRN D EN^IBTRE4(IBTRN)
144 .Q
145 S VALMBCK="R"
146 Q
147 ;
148PRV ; -- provider editing
149 N VALMY,I,J,IBXXT
150 D EN^VALM2($G(XQORNOD(0)))
151 I $D(VALMY) S IBXXT=0 F S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT D
152 .S IBTRN=$P($G(^TMP("IBTREDX",$J,+$O(^TMP("IBTRE",$J,"IDX",IBXXT,0)))),"^",2)
153 .I IBTRN D EN^IBTRE5(IBTRN)
154 .Q
155 S VALMBCK="R"
156 Q
Note: See TracBrowser for help on using the repository browser.