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