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

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1IBTRVD1 ;ALB/AAS - CLAIMS TRACKING REVIEW EDIT ; 06-JUL-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;**1,10**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% G ^IBTRV
6 ;
7QE ; -- Review Criteria edit
8 N IBXX,VALMY,DA,DR,DIC,DIE
9 D QE1^IBTRV1
10 D BLD^IBTRVD
11 S VALMBCK="R"
12 Q
13 ;
14NX(IBTMPNM,BLD) ; -- edit next template
15 N IBXX,VALMY,IBTRC
16 D EN^VALM(IBTMPNM)
17 I '$D(IBFASTXT),'$G(BLD) D BLD^IBTRVD
18 S VALMBCK="R"
19 Q
20 ;
21EDIT(DR,BLD) ; -- edit entry point for claims tracking reviews
22 ; -- Input IBTEMP = template name or dr string
23 ; BLD = any non-zero value if calling routine is doing own
24 ; rebuild
25 ;
26 N IBDIF,DA,DIC,DIE,DIR,X,Y
27 D FULL^VALM1 W !
28 L +^IBT(356.1,+IBTRV):5 I '$T D LOCKED^IBTRCD1 G EDITQ
29 D SAVE
30 S DIE="^IBT(356.1,",DA=IBTRV
31 D ^DIE K DA,DR,DIC,DIE
32 D COMP
33 I '$D(IBCON) D CON K IBCON
34 I IBDIF=1 D UPDATE,BLD^IBTRVD:'$G(BLD)
35 L -^IBT(356.1,+IBTRN)
36EDITQ K ^TMP($J,"IBT")
37 S VALMBCK="R"
38 Q
39 ;
40SAVE ; -- Save the global before editing
41 K ^TMP($J,"IBT")
42 S ^TMP($J,"IBT",356.1,IBTRV,0)=$G(^IBT(356.1,IBTRV,0))
43 S ^TMP($J,"IBT",356.1,IBTRV,1)=$G(^IBT(356.1,IBTRV,1))
44 S ^TMP($J,"IBT",356.1,IBTRV,11,0)=$G(^IBT(356.1,IBTRV,11,0))
45 Q
46 ;
47COMP ; -- Compare before editing with globals
48 S IBDIF=0
49 I $G(^IBT(356.1,IBTRV,0))'=$G(^TMP($J,"IBT",356.1,IBTRV,0)) S IBDIF=1 Q
50 I $G(^IBT(356.1,IBTRV,1))'=$G(^TMP($J,"IBT",356.1,IBTRV,1)) S IBDIF=1 Q
51 I $G(^IBT(356.1,IBTRV,11,0))'=$G(^TMP($J,"IBT",356.1,IBTRV,11,0)) S IBDIF=1 Q
52 Q
53 ;
54UPDATE ; -- enter date and user if editing has taken place
55 ; entry locked by edit, locks not needed here
56 S DIE="^IBT(356.1,",DA=IBTRV
57 S DR="1.03///NOW;1.04////"_DUZ
58 D ^DIE K DA,DR,DIC,DIE
59 Q
60 ;
61CON ; -- consistency checker for hospital reviews
62 Q:$G(^IBT(356.1,IBTRV,0))=""
63 N I,J,X,Y,DA,DR,DIC,DIE,IBI,IBTRTP,IBDEL
64 S IBCON=1
65 S IBTRTP=$P($G(^IBE(356.11,+$P($G(^IBT(356.1,IBTRV,0)),"^",22),0)),"^",2)
66 ; -- if admission review
67 I IBTRTP=15 D
68 .S X=$G(^IBT(356.1,IBTRV,0))
69 .I '$P(X,"^",4),'$P(X,"^",5),'$P(X,"^",6),'$O(^IBT(356.1,IBTRV,12,0)) W !!,*7,"Warning: Admission Criteria does NOT appear to be met but Reason for",!,"Non Acute Admission Missing." D EDIT("12",1)
70 .I $P(X,"^",4),($P(X,"^",5)),($P(X,"^",6)),$O(^IBT(356.1,IBTRV,12,0)) W !!,*7,"Warning: Admission Criteria appears to be met but has Reason for ",!,"Non Acute Admission." D EDIT("12",1)
71 .Q
72 ; -- if cont. stay review
73 I IBTRTP=30 D
74 .S X=$G(^IBT(356.1,IBTRV,0))
75 .I '$P(X,"^",4),'$P(X,"^",5),$P(X,"^",12),'$O(^IBT(356.1,IBTRV,13,0)) W !!,*7,"Warning: Acute Care Criteria does NOT appear to be met but Reason for",!,"Non Acute Days Missing." D EDIT(13,1)
76 .I $P(X,"^",4),($P(X,"^",5)),$O(^IBT(356.1,IBTRV,13,0)) W !!,*7,"Warning: Acute Care Criteria appears to be met but has Reason for ",!,"Non Acute Days." D EDIT(13,1)
77 .Q
78 ; -- check Next Review Dates
79 S IBI=0 F S IBI=$O(^IBT(356.1,"C",IBTRN,IBI)) Q:'IBI I IBI'=IBTRV D
80 .I $P($G(^IBT(356.1,IBI,0)),"^",20) S IBI(IBI)=""
81 .Q
82 I $O(IBI(0)) D ASKDEL I IBDEL D
83 .I $P(^IBT(356.1,IBTRV,0),U,20) D
84 ..W !," There are other reviews for this admission with a next review date"
85 ..W !," specified. Generally, only the last review for an admission should"
86 ..W !," have a next review date. Please check the reviews for this case and"
87 ..W !," delete all unnecessary 'next review dates'."
88 ..H 3 Q
89 .I $O(IBI(+$O(IBI(0)))) D
90 .;S IBI=0 F S IBI=$O(IBI(IBI)) Q:'IBI S DA=IBI,DR=".2///@",DIE="^IBT(356.1," D ^DIE
91 .;W !,"Next Review Dates have all been deleted, except for this review"
92 .Q
93 Q
94 ;
95ASKDEL ; -- ask if okay to delete next review dates
96 S IBDEL=1
97 Q
98 ;
99IA(IBTRV,BLD) ; -- Insurance action
100 ; -- add/edit communications in bkgrnd for a review
101 ; quick edit a communications entry.
102 ;
103 I '$G(BLD) D BLD^IBTRVD
104 S VALMBCK="R"
105 Q
Note: See TracBrowser for help on using the repository browser.