| [613] | 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
|
|---|
