| 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
 | 
|---|