source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRKR2.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1IBTRKR2 ;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% ;
6EN ; -- 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 ;
41ENQ 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 ;
46SCH(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))
52SCHQ Q IBTSA
Note: See TracBrowser for help on using the repository browser.