source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRV.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: 5.3 KB
RevLine 
[613]1IBTRV ;ALB/AAS - CLAIMS TRACKING REVIEWS (UR) ; 27-JUN-1993
2 ;;2.0;INTEGRATED BILLING;**40,121,124,250,277**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% ;
6EN ; -- main entry point for IBT REVIEW EDITOR from menu's
7 ;
8 I '$D(DT) D DT^DICRW
9 K XQORS,VALMEVL,IBTRV,IBTRN,DFN,IBTRC,IBTRD,IBFASTXT,VALMQUIT
10 G:$D(VALMQUIT) ENQ
11 D PAT^IBCNSM I $D(VALMQUIT) G ENQ
12 D TRAC I $D(VALMQUIT) G ENQ
13 I '$G(IBTRPRF) S IBTRPRF="12"
14 D EN^VALM("IBT REVIEW EDITOR")
15ENQ K XQORS,VALMEVL,IBTRV,IBTRN,DFN,IBTRC,IBTRD,IBFASTXT,VALMQUIT,IBI,IBICD,IBTRND,VA,VAERR,VA200,VAINDT,X,Y,IBTRPRF,IBCNT,VALMBCK,OFFSET,I1,I3,IBNEW,IBDENT,IBOE,Z1,T,SDCNT
16 K IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
17 K IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
18 D KVAR^VADPT
19 Q
20 ;
21HDR ; -- header code
22 D PID^VADPT
23 S VALMHDR(1)=" Hospital Review Entries for: "_$$PT^IBTUTL1(DFN)_" ROI: "_$$EXPAND^IBTRE(356,.31,$P(^IBT(356,IBTRN,0),"^",31))
24 S VALMHDR(2)=" for: "_$$EXPAND^IBTRE(356,.18,$P(IBTRND,"^",18))_" on "_$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P")
25 Q
26 ;
27INIT ; -- init variables and list array
28 S U="^",VALMCNT=0,VALMBG=1
29 K ^TMP("IBTRV",$J),^TMP("IBTRVDX",$J),I,X,XQORNOD,DA,DR,DIE,DNM,DQ
30 S IBTRND=$G(^IBT(356,+IBTRN,0)) D BLD Q
31 ;
32BLD ; -- Build list of Reviews
33 K ^TMP("IBTRV",$J),^TMP("IBTRVDX",$J)
34 N IBI,J,IBTRV,IBTRVD,IBUR
35 S IBUR=$$IBUR(IBTRN)
36 I IBUR'="" S VALMSG=IBUR
37 S (IBTRV,IBCNT,VALMCNT)=0,IBI=""
38 F S IBI=$O(^IBT(356.1,"ATIDT",+IBTRN,IBI)) Q:'IBI S IBTRV=0 F S IBTRV=$O(^IBT(356.1,"ATIDT",IBTRN,IBI,IBTRV)) Q:'IBTRV D
39 .W "."
40 .S IBTRVD=$G(^IBT(356.1,+IBTRV,0))
41 .Q:'+$P(IBTRVD,"^",21) ;quit if inactive
42 .N VAIN,VAINDT S VAINDT=$$VNDT(IBTRV) D INP^VADPT
43 .I VAIN(4)="" S VAINDT=$P(IBTRND,"^",6) D INP^VADPT
44 .S IBCNT=IBCNT+1
45 .S X=""
46 .S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
47 .S X=$$SETFLD^VALM1($$DAT1^IBOUTL(+IBTRVD,2),X,"RV DATE")
48 .;S X=$$SETFLD^VALM1($P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^"),X,"TYPE")
49 .S X=$$SETFLD^VALM1($P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^",3),X,"TYPE")
50 .S X=$$SETFLD^VALM1($E($$EXPAND^IBTRE(356.1,.21,$P(IBTRVD,"^",21)),1,8),X,"STATUS")
51 .S X=$$SETFLD^VALM1($P($G(^DIC(45.7,+$P(IBTRVD,"^",7),0)),"^"),X,"SPEC")
52 .S X=$$SETFLD^VALM1($J($P(IBTRVD,"^",3),2),X,"DAY")
53 .S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBTRVD,"^",20),2),X,"NEXT")
54 .S X=$$SETFLD^VALM1($P(VAIN(4),"^",2),X,"WARD")
55 .S X=$$SETFLD^VALM1(VAIN(5),X,"BED")
56 .S X=$$SETFLD^VALM1(IBUR,X,"RV REASON")
57 .D SET(X)
58 Q
59 ;
60SET(X) ; -- set arrays
61 S VALMCNT=VALMCNT+1
62 S ^TMP("IBTRV",$J,VALMCNT,0)=X
63 S ^TMP("IBTRV",$J,"IDX",VALMCNT,IBCNT)=""
64 S ^TMP("IBTRVDX",$J,IBCNT)=VALMCNT_"^"_IBTRV
65 Q
66HELP ; -- help code
67 S X="?" D DISP^XQORM1 W !!
68 Q
69 ;
70EXIT ; -- exit code
71 K ^TMP("IBTRV",$J),^TMP("IBTRVDX",$J)
72 K IBTRV D CLEAN^VALM10 Q
73 ;
74TRAC ; -- Select tracking entry
75 N X,Y,DIC,IBDFLT
76 I '$D(DFN) S VALMQUIT="" G TRACQ
77 ;S DIC("A")="Select VISIT: ",D="ADFN"_DFN
78 ;S DIC("S")="I $P(^(0),U,20)"
79 ;; Patch 40 custom look.
80 ;S DIC("W")="S IBX=^(0) D PRINT^IBTRE20"
81 ;S DIC="^IBT(356,",DIC(0)="EQS",X="???" D IX^DIC
82 ;
83 S IBDFLT=$$DEFV(DFN)
84 D LIST(DFN,IBDFLT)
85 ;
86 S DIC("A")="Select VISIT: "
87 S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,20)"
88 S DIC="^IBT(356,",DIC(0)="AEQNM"
89 I IBDFLT S DIC("B")=IBDFLT
90 ; -- return IBY = Y as returned by dic
91 D ^DIC S IBY=Y I +Y<1 S VALMQUIT="" G TRACQ
92 S IBTRN=+Y
93TRACQ Q
94 ;
95DEFV(DFN) ; -- compute default visit for patient
96 N X,IBA,IBJ,IBX,IBY S X=""
97 I '+$G(DFN) G DEFVQ
98 I '$O(^IBT(356,"C",DFN,0)) G DEFVQ
99 ; -- default = current inpt
100 S IBA=+$G(^DPT(DFN,.105)),X="" I IBA S X=$P($G(^IBT(356,+$O(^IBT(356,"AD",+IBA,0)),0)),"^") I X G DEFVQ
101 ;
102 S IBX=0 F S IBX=$O(^IBT(356,"ADFN"_DFN,IBX)) Q:'IBX S IBY=$O(^IBT(356,"ADFN"_DFN,IBX,0)) I $P($G(^IBT(356,+IBY,0)),"^",20) D
103 .I $P(^IBT(356,+IBY,0),"^",32),'$P(^(0),"^",5) S X=IBX
104 .S IBJ=IBX
105 I X G DEFVQ
106 ;
107 S IBX=0 F S IBX=$O(^IBT(356,"ADM",DFN,IBX)) Q:'IBX S IBY=$O(^IBT(356,"ADM",DFN,IBX,0)) D
108 .I $P($G(^IBT(356,+IBY,0)),"^",20) S X=$P(^(0),"^")
109 G:$L(X) DEFVQ
110 S X=$G(IBJ)
111 ;
112DEFVQ Q X
113VNDT(X) ; -- compute vaindt for call to inp^vadtp
114 ; -- Input x = internal entry of review
115 N Y S Y=""
116 S Y=+$G(^IBT(356.1,+$G(X),0)) S:$$TRTP(+$G(X))'=40 Y=Y+.24
117 Q Y
118 ;
119TRTP(X) ; -- Compute Review type code
120 ; Input x = internal entry of review
121 ; output = code for review from 356.11
122 Q $P($G(^IBE(356.11,+$P($G(^IBT(356.1,+$G(X),0)),"^",22),0)),"^",2)
123 ;
124IBUR(IBTRN) ; -- reason for review
125 N IBUR,IBTRND
126 S IBUR="",IBTRND=$G(^IBT(356,+$G(IBTRN),0))
127 S:$P(IBTRND,"^",25) IBUR="Random Sample" S:$P(IBTRND,"^",26) IBUR=IBUR_$S(IBUR="":"",1:"/")_$$EXPAND^IBTRE(356,.26,$P(IBTRND,"^",26))
128 S:$P(IBTRND,"^",27) IBUR=IBUR_$S(IBUR="":"",1:"/")_"Local Addition"
129 Q IBUR
130 ;
131LIST(DFN,DFLT) ; list 1 screen of most recent CT entries
132 Q:'$G(DFN) N IBX,IBY,IBA,IBCNT S IBCNT=0
133 ;
134 W !!,"Choose from:"
135 S IBY="" F S IBY=$O(^IBT(356,"C",DFN,IBY),-1) Q:'IBY D Q:IBCNT>17
136 . I +$P($G(^IBT(356,+IBY,0)),U,20) S IBCNT=IBCNT+1,IBA(IBY)=""
137 I '$O(IBA("")) W !," There are no Claims Tracking entries for this patient."
138 I +IBY,+$O(^IBT(356,"C",DFN,IBY),-1) W !," ..."
139 ;
140 S IBY="" F S IBY=$O(IBA(IBY)) Q:'IBY S IBX=$G(^IBT(356,IBY,0)) W !,?3,$P(IBX,U,1) D PRINT^IBTRE20
141 ;
142 I $G(DFLT)'="" S IBY=+$O(^IBT(356,"B",DFLT,0)) I +IBY S IBX=$G(^IBT(356,+IBY,0)) W !!,?3,$P(IBX,U,1) D PRINT^IBTRE20
143 W !
144 Q
Note: See TracBrowser for help on using the repository browser.