1 | IBTRKR2 ;ALB/AAS - ADD/TRACK SCHEDULED ADMISSION ;9-AUG-93
|
---|
2 | ;;2.0;INTEGRATED BILLING;**43,62,214,312**;21-MAR-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | % ;
|
---|
6 | EN ; -- add scheduled admissions to claims tracking file
|
---|
7 | N I,J,X,Y,IBTRKR,IBI,IBJ,DFN,IBDATA
|
---|
8 | N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI() ;IB*2.0*312
|
---|
9 | S IBTRKR=$G(^IBE(350.9,1,6))
|
---|
10 | G:'$P(IBTRKR,"^",2) ENQ ; inpatient tracking off
|
---|
11 | S:'$G(IBTSBDT) IBTSBDT=$$FMADD^XLFDT(DT,-3)-.1
|
---|
12 | S:'$G(IBTSEDT) IBTSEDT=$$FMADD^XLFDT(DT,7)+.9
|
---|
13 | I IBTSBDT<+IBTRKR S IBTSBDT=+IBTRKR-.1 ; start date can't be before ct start date
|
---|
14 | S IBI=IBTSBDT-.0001
|
---|
15 | F S IBI=$O(^DGS(41.1,"C",IBI)) Q:'IBI!(IBI>IBTSEDT) S IBJ="" F S IBJ=$O(^DGS(41.1,"C",IBI,IBJ)) Q:'IBJ D
|
---|
16 | .;
|
---|
17 | .;Do NOT PROCESS on VistA if IBI/Sched DT>=Switch Eff Dt ;CCR-930
|
---|
18 | .I +IBSWINFO,(IBI+1)>$P(IBSWINFO,"^",2) Q ;IB*2.0*312
|
---|
19 | .;
|
---|
20 | .S IBDATA=$G(^DGS(41.1,IBJ,0))
|
---|
21 | .S DFN=+IBDATA
|
---|
22 | .Q:'DFN ; no patient
|
---|
23 | .Q:$P(IBDATA,"^",17) ; already admitted
|
---|
24 | .;
|
---|
25 | .S IBTRN=$O(^IBT(356,"ASCH",IBJ,0))
|
---|
26 | .I $P(IBDATA,"^",13) D:IBTRN INACTIVE^IBTRKRU(IBTRN) Q ; canceled
|
---|
27 | .;
|
---|
28 | .; - if not in ct add
|
---|
29 | .I 'IBTRN D Q
|
---|
30 | ..I $P(IBTRKR,"^",2)=2 D SCH^IBTUTL2(DFN,IBI,IBJ) Q
|
---|
31 | ..I $P(IBTRKR,"^",2)=1,$S('$$INSURED^IBCNS1(DFN,+IBI):0,1:$$PTCOV^IBCNSU3(DFN,+IBI,"INPATIENT")) D SCH^IBTUTL2(DFN,IBI,IBJ) Q
|
---|
32 | ..D TRKR^IBCNRDV(DFN,IBI,IBJ,$P(IBDATA,"^",11))
|
---|
33 | ..Q
|
---|
34 | .;
|
---|
35 | .; - if inactive re-activate
|
---|
36 | .I '$P(^IBT(356,+IBTRN,0),"^",20) D
|
---|
37 | ..N X,Y,I,J,DA,DR,DIE,DIC
|
---|
38 | ..S DA=IBTRN,DR=".2////1",DIE="^IBT(356," D ^DIE
|
---|
39 | .Q
|
---|
40 | ;
|
---|
41 | ENQ K IBTSEDT,IBTSBDT
|
---|
42 | ; add cleanup of ARDV
|
---|
43 | S X=0 F S X=$O(^IBT(356,"ARDV",X)) Q:X<1 S Y=0 F S Y=$O(^IBT(356,"ARDV",X,Y)) Q:Y<1 I Y<DT K ^IBT(356,"ARDV",X,Y)
|
---|
44 | Q
|
---|
45 | ;
|
---|
46 | SCH(DGPMCA) ; -- is this admission movement a scheduled admission
|
---|
47 | ; -- output scheduled admission pointer
|
---|
48 | ;
|
---|
49 | N IBTSA S IBTSA=0
|
---|
50 | I '$G(DGPMCA) G SCHQ
|
---|
51 | S IBTSA=+$O(^DGS(41.1,"AMVT",DGPMCA,0))
|
---|
52 | SCHQ Q IBTSA
|
---|