source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAMTS.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1IBAMTS ;ALB/CPM - APPOINTMENT EVENT DRIVER INTERFACE ;20-JUL-93
2 ;;2.0;INTEGRATED BILLING;**52,115,132,153,164,156,171,247,312,341,339**;21-MAR-94;Build 2
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5EN ; Main interface entry point.
6 ;
7 N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI() ;IB*2.0*312
8 I '$G(DUZ) D DUZ^XUP(.5) ;IB*2.0*341 Setting of DUZ covered by IA 4129
9 ;
10 S IBJOB=5,IBWHER="",IBDUZ=DUZ,IBY=1
11 ; Do Transfer Pricing
12 I '+IBSWINFO D ^IBATEO ;IB*2.0*312
13 ; Check Encounter Related to LTC
14 N IBALTC D EN^IBAECO
15 I '$$BILST^DGMTUB(DFN) G ENQ ; never Means Test billable
16 I '$$CHECK^IBECEAU(0) D ^IBAERR1 G ENQ ; can't set vital parameters
17 ;
18 ; - process all parent outpatient encounters
19 S IBORG=0 F S IBORG=$O(^TMP("SDEVT",$J,SDHDL,IBORG)) Q:'IBORG D
20 .S IBOE=0 F S IBOE=$O(^TMP("SDEVT",$J,SDHDL,IBORG,"SDOE",IBOE)) Q:'IBOE S IBEVT=$G(^(IBOE,0,"AFTER")),IBEV0=$G(^("BEFORE")) D
21 ..;
22 ..S IBDT=$S(IBEVT:+IBEVT,1:+IBEV0),IBDAT=$P(IBDT,".")
23 ..; Do NOT PROCESS on VistA if IBDAT>=Switch Eff Date ;CCR-930
24 ..I +IBSWINFO,(IBDAT+1)>$P(IBSWINFO,"^",2) Q ;IB*2.0*312
25 ..;
26 ..S IBAPTY=$S(IBEVT:$P(IBEVT,"^",10),1:$P(IBEV0,"^",10))
27 ..S IBBILLED=$$BFO^IBECEAU(DFN,IBDAT),IBY=1
28 ..;
29 ..; - if C&P encounter, cancel charges for the day and quit
30 ..I IBAPTY=1!(IBALTC) D:IBBILLED Q
31 ...S IBCRES=+$O(^IBE(350.3,"B",$S(IBALTC:"BILLED LTC CHARGE",1:"COMP & PENSION VISIT RECORDED"),0))
32 ...S:'IBCRES IBCRES=23 S IBWHER=""
33 ...D CANCH^IBECEAU4(IBBILLED,IBCRES,0)
34 ..;
35 ..; - quit if there are any C&P encounters on the visit date
36 ..Q:$$CNP^IBECEAU(DFN,IBDAT)
37 ..;
38 ..; - quit if there are any LTC encounters on the visit date
39 ..Q:$$LTCENC^IBAECU(DFN,IBDAT)
40 ..;
41 ..; - don't process child events
42 ..I IBEVT]"" Q:$P(IBEVT,"^",6)
43 ..I IBEVT="",IBEV0]"" Q:$P(IBEV0,"^",6)
44 ..;
45 ..; - get statuses
46 ..S IBAST=+$P(IBEVT,"^",12),IBBST=+$P(IBEV0,"^",12)
47 ..;
48 ..; - do either NEW or UPDATED processing
49 ..I IBAST=2,IBBST'=2 D NEW^IBAMTS1 Q
50 ..D UPD^IBAMTS2
51 ;
52ENQ K IBJOB,IBWHER,IBORG,IBOE,IBEVT,IBEV0,IBAST,IBBST,IBDUZ,IBY
53 K IBDT,IBDAT,IBAPTY,IBBILLED,IBSERV,IBSITE,IBFAC,IBCRES,IBRTED
54 Q
55 ;
56BULL ; Send bulletin when classified patients are billed stops which
57 ; are exempt from the classification process.
58 N IBT,IBC,IBPT,IBDUZ,IBX S IBPT=$$PT^IBEFUNC(DFN),IBX=$$CLTY
59 S XMSUB="CHARGE FOR STOP CODE EXEMPT FROM CLASSIFICATION"
60 S IBT(1)="The following patient, who "_$S(IBX="SC":"has a service connected disability,",IBX="CV":"is Combat Veteran",1:"has claimed exposure to "_IBX_",")
61 S IBT(2)="was billed the Means Test outpatient copay for a stop code which is"
62 S IBT(3)="exempt from classification:"
63 S IBT(4)=" " S IBC=4
64 S IBDUZ=DUZ D PAT^IBAERR1
65 S Y=IBDAT D DD^%DT
66 S IBC=IBC+1,IBT(IBC)="Stop Date: "_Y
67 S IBC=IBC+1,IBT(IBC)="Stop Code: "_$P($G(^DIC(40.7,+$P(IBEVT,"^",3),0)),"^")
68 S IBC=IBC+1,IBT(IBC)=" "
69 S IBC=IBC+1,IBT(IBC)="Please check this patient's medical record to determine if the care provided"
70 S IBC=IBC+1,IBT(IBC)="was related to the "_$S(IBX="SC":"SC disability",IBX="CV":"Combat Veteran status",1:"claimed exposure")_", and, if related, cancel the charge."
71 D MAIL^IBAERR1
72 K X,Y,XMSUB,XMY,XMTEXT,XMDUZ
73 Q
74 ;
75CLTY() ; Return the classification type
76 N IBARR,Y D CL^SDCO21(DFN,IBDAT,"",.IBARR) S Y=""
77 I $D(IBARR(3)) S Y="SC" G CLTYQ
78 I $D(IBARR(7)),+$$CVEDT^IBACV(DFN,IBDAT) S Y="CV" G CLTYQ
79 I $D(IBARR(1)) S Y="Agent Orange" G CLTYQ
80 I $D(IBARR(2)) S Y="Ionizing Radiation" G CLTYQ
81 I $D(IBARR(4)) S Y="Southwest Asia" G CLTYQ
82 I $D(IBARR(8)) S Y="Project 112/SHAD" G CLTYQ
83 I $D(IBARR(5)) S Y="Military Sexual Trauma" G CLTYQ
84 I $D(IBARR(6)) S Y="Head/Neck Cancer" G CLTYQ
85CLTYQ Q Y
Note: See TracBrowser for help on using the repository browser.