1 | IB20P318 ;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 | ;
|
---|
8 | POST ;
|
---|
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 | ;
|
---|
20 | ATADD ; 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 | ;
|
---|
41 | ATADDQ D MES^XPDUTL(.IBA) K IBA
|
---|
42 | Q
|
---|
43 | ;
|
---|
44 | ;
|
---|
45 | MSG(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
|
---|