1 | IBJDI11 ;ALB/CPM - PERCENTAGE OF COMPLETED REGISTRATIONS (CONT'D) ;16-DEC-96
|
---|
2 | ;;2.0;INTEGRATED BILLING;**100,118,128,249**;21-MAR-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | EN ; - Entry point from IBJDI1.
|
---|
6 | ;
|
---|
7 | ; - Get patient's most recent registration.
|
---|
8 | S IBREG=$G(^DPT(DFN,"DIS",+$O(^DPT(DFN,"DIS",0)),0)) I 'IBREG G ENQ
|
---|
9 | ;
|
---|
10 | ; - Get division, if necessary.
|
---|
11 | I 'IBSORT S IBDIV=0
|
---|
12 | E S IBDIV=+$P(IBREG,U,4) I 'IBDIV S IBDIV=+$$PRIM^VASITE()
|
---|
13 | I IBSORT,'VAUTD,'$D(VAUTD(IBDIV)) Q ; Not a selected division.
|
---|
14 | ;
|
---|
15 | ; - Set 'total registrations' accumulator.
|
---|
16 | S IB(IBDIV,"TOT")=IB(IBDIV,"TOT")+1
|
---|
17 | ;
|
---|
18 | ; - Check if patient is a non-veteran.
|
---|
19 | D ELIG^VADPT S IBNVET=$S('VAEL(4):1,1:0)
|
---|
20 | ;
|
---|
21 | ; - Check if patient is deceased; get DOD.
|
---|
22 | I +$G(^DPT(DFN,.35)) D
|
---|
23 | .S IBDOD=$$DAT1^IBOUTL(+^DPT(DFN,.35)\1),IB(IBDIV,"DEC")=IB(IBDIV,"DEC")+1
|
---|
24 | E S IBDOD=""
|
---|
25 | ;
|
---|
26 | ; - Check if patient is/was getting inpatient care.
|
---|
27 | S IBINPT=""
|
---|
28 | I $$INPT^IBAMTS1(DFN,IBEDT) S IBINPT="*"
|
---|
29 | E S IBX=$O(^DGPM("APTT3",DFN,(IBBDT-.01)))\1 I IBX,IBX<IBEDT S IBINPT="*"
|
---|
30 | ;
|
---|
31 | ; - Check for 'no billable treatment' dispositions.
|
---|
32 | I $$NOTR(DFN,IBBDT,IBEDT,0) S IBNOTR="+",IB(IBDIV,"NOTR")=IB(IBDIV,"NOTR")+1
|
---|
33 | E S IBNOTR="",IB(IBDIV,"TR")=IB(IBDIV,"TR")+1
|
---|
34 | ;
|
---|
35 | ; - Set accumulators for the breakdown of the total number.
|
---|
36 | D INC(DFN,.IBIN)
|
---|
37 | I IBIN]"" D:IBNOTR="" G EN1
|
---|
38 | .I IBNVET D
|
---|
39 | ..S IBIN=+$P(IBREG,U,13)_";"_IBIN,IB(IBDIV,"NVETI")=IB(IBDIV,"NVETI")+1
|
---|
40 | .E S IB(IBDIV,"VETI")=IB(IBDIV,"VETI")+1
|
---|
41 | .S IB(IBDIV,"INC")=IB(IBDIV,"INC")+1
|
---|
42 | I IBNOTR="" D
|
---|
43 | .S IB(IBDIV,"COM")=IB(IBDIV,"COM")+1
|
---|
44 | .I IBNVET S IB(IBDIV,"NVETC")=IB(IBDIV,"NVETC")+1
|
---|
45 | .E S IB(IBDIV,"VETC")=IB(IBDIV,"VETC")+1
|
---|
46 | ;
|
---|
47 | EN1 I IBRPT="S"!(IBIN="") G ENQ ; Summary info only/No inconsistencies.
|
---|
48 | ;
|
---|
49 | ; - Get patient's type of care.
|
---|
50 | S X=+$P(IBREG,U,3),IBTOC=$S(X=1:"HOSPITAL",X=2:"DOMICILIARY",X=3:"OPT. MEDICAL",X=4:"OPT. DENTAL",X=5:"N.H. CARE",1:"")
|
---|
51 | ;
|
---|
52 | ; - Get next scheduled treatment date.
|
---|
53 | S IBNEXT=""
|
---|
54 | I $$GETICN^MPIF001(DFN)>0 S ^TMP("IBDFN",$J,DFN)="" ; for future look up scheduled appts.
|
---|
55 | S X=0 F S X=$O(^DGS(41.1,"B",DFN,X)) Q:'X D ; Scheduled adm.
|
---|
56 | .S X1=$G(^DGS(41.1,X,0)),X2=$P(X1,U,2)\1
|
---|
57 | .I X2<DT Q ; Must be old scheduled admission.
|
---|
58 | .I $P(X1,U,13) Q ; Scheduled admission is cancelled.
|
---|
59 | .I $P(X1,U,17) Q ; Patient already admitted.
|
---|
60 | .I X2>IBNEXT S IBNEXT=X2
|
---|
61 | ;
|
---|
62 | ; - Save detail information.
|
---|
63 | S ^TMP("IBJDI1",$J,IBDIV,IBNVET,$E($P(IBDN,U),1,25)_IBINPT_IBNOTR_"@@"_DFN)=$P(IBDN,U,9)_U_$E($P($G(^DPT(DFN,.13)),U),1,15)_U_IBTOC_U_IBIN_U_$E($P($G(^VA(200,+$P(IBREG,U,9),0)),U),1,20)_U_IBNEXT_U_IBDOD
|
---|
64 | ;
|
---|
65 | ENQ K VA,VAEL,VAERR
|
---|
66 | Q
|
---|
67 | ;
|
---|
68 | NOTR(DFN,IBBDT,IBEDT,Z) ; - Check for patient's 'no treatment' dispositions.
|
---|
69 | ; Input: DFN = Patient IEN
|
---|
70 | ; IBBDT = Start date for search
|
---|
71 | ; IBEDT = Ending date for search
|
---|
72 | ; Z = 1-Look for 'no treatment' dispositions only
|
---|
73 | ; 0-Also look for C&P/emply/collat/non-ct clinic visits
|
---|
74 | ; Output: 0 = Patient had no 'no treatment' dispositions or patient
|
---|
75 | ; had treatment within selected date range
|
---|
76 | ; 1 = Patient had at least one 'no treatment' disposition or
|
---|
77 | ; C&P exam/employee/collateral/non-count clinic visit
|
---|
78 | ;
|
---|
79 | N IBDIS,VAROOT,VARP,X,X1,X2,Y
|
---|
80 | S VAROOT="IBDIS",VARP("F")=IBBDT,VARP("T")=IBEDT D REG^VADPT
|
---|
81 | S Y=1 I '$O(IBDIS(0)) G NTQ
|
---|
82 | S (X,X1)=0 F S X=$O(IBDIS(X)) Q:X="" D I X1 S Y=0 Q
|
---|
83 | .S X2=+$P($G(^DPT(DFN,"DIS",9999999-$P(IBDIS(X,"I"),U,6),0)),U,18)
|
---|
84 | .S X2=$G(^SCE(X2,0))
|
---|
85 | .I $P(X2,U,8)'=2,"^CANCEL WITHOUT EXAM^NO CARE OR TREATMENT REQUIRED^"[("^"_$P(IBDIS(X,"E"),U,7)_"^") Q
|
---|
86 | .I 'Z,"^1^4^7^"[("^"_+$P(X2,U,10)_"^") Q ; C&P/collat/emply visit.
|
---|
87 | .I 'Z,$P($G(^SC(+$P(X2,U,4),0)),U,17)="Y" Q ; Non-count clinic.
|
---|
88 | .S X1=1 ; Patient had treatment.
|
---|
89 | ;
|
---|
90 | NTQ Q Y
|
---|
91 | ;
|
---|
92 | INC(DFN,X) ; - Find a patient's registration inconsistencies.
|
---|
93 | ; Input: DFN = Pointer to the patient in file #2
|
---|
94 | ; Output: X = Passed by reference - the patient's
|
---|
95 | ; registration inconsistencies in the form
|
---|
96 | ;
|
---|
97 | ; n;n1;n2;n3...
|
---|
98 | ;
|
---|
99 | ; where n is a pointer to file #38.6.
|
---|
100 | N I S X=""
|
---|
101 | S I=0 F S I=$O(^DGIN(38.5,DFN,"I",I)) Q:'I S X=X_I_";"
|
---|
102 | I X]"" S X=$E(X,1,$L(X)-1)
|
---|
103 | Q
|
---|