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

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1IB20P318 ;ALB/ARH - IB*2.0*318 POST INIT: ADD BILLABLE APPT TYPE ; 23-JUN-2005
2 ;;2.0;INTEGRATED BILLING;**318**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6 Q
7 ;
8POST ;
9 N IBA
10 S IBA(1)="",IBA(2)=" IB*2*318 Post-Install .....",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
11 ;
12 D ATADD ; Add New Billable Appointment Type
13 ;
14 S IBA(1)="",IBA(2)=" IB*2*318 Post-Install Complete",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
15 ;
16 Q
17 ;
18 ;
19 ;
20ATADD ; New Billable Appointment Type (352.1) to correspond to the New 'SERVICE CONNECTED' Appointment Type (409.1)
21 N DD,DO,DLAYGO,DINUM,DIC,DIE,DA,DR,X,Y,IBA,IBFOUND,IBATFN,IBNUM,IBAT,IBFN
22 ;
23 S IBA(1)=" >> Adding 'Service Connected' Billable Appointment Type (#352.1)"
24 ;
25 S (IBATFN,IBNUM)=11,IBAT="SERVICE CONNECTED"
26 ;
27 S IBFOUND=$G(^IBE(352.1,IBATFN,0))
28 ;
29 I $P(IBFOUND,U,1,3)="11^11^2880101" D MSG(" Done. Billable Appointment Type Already Exists") G ATADDQ
30 I IBFOUND'="" D MSG(" "),MSG(" *** ERROR: Entry already Exists, could not add") G ATADDQ
31 I +$O(^IBE(352.1,"B",IBNUM,0)) D MSG(" "),MSG(" *** ERROR: Number already Exists, could not add") G ATADDQ
32 ;
33 K DD,DO S DINUM=IBATFN,DLAYGO=352.1,DIC="^IBE(352.1,",DIC(0)="L",X=IBATFN D FILE^DICN K DIC S IBFN=+Y
34 I Y<1 K X,Y D MSG(" "),MSG(" *** ERROR: New Entry could not be added") G ATADDQ
35 ;
36 S DR=".02///"_IBAT_";.03////2880101;.04///NO;.05///YES;.06///YES"
37 S DIE="^IBE(352.1,",DA=+IBFN D ^DIE K DIE,DA,DR,X,Y
38 ;
39 D MSG(" Done. Service Connected Billable Appointment Type Added")
40 ;
41ATADDQ D MES^XPDUTL(.IBA) K IBA
42 Q
43 ;
44 ;
45MSG(X) ;
46 N IBX S IBX=$O(IBA(999999),-1) S:'IBX IBX=1 S IBX=IBX+1
47 S IBA(IBX)=$G(X)
48 Q
Note: See TracBrowser for help on using the repository browser.