IB20P318.m

IB20P318 ;ALB/ARH - IB*2.0*318 POST INIT: ADD BILLABLE APPT TYPE ; 23-JUN-2005

 ;;2.0;INTEGRATED BILLING;**318**;21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

 ;

 Q

 ;

POST ;

 N IBA

 S IBA(1)="",IBA(2)="    IB*2*318 Post-Install .....",IBA(3)="" D MES^XPDUTL(.IBA) K IBA

 ;

 D ATADD ; Add New Billable Appointment Type

 ;

 S IBA(1)="",IBA(2)="    IB*2*318 Post-Install Complete",IBA(3)="" D MES^XPDUTL(.IBA) K IBA

 ;

 Q

 ;

 ;

 ;

ATADD ; New Billable Appointment Type (352.1) to correspond to the New 'SERVICE CONNECTED' Appointment Type (409.1)

 N DD,DO,DLAYGO,DINUM,DIC,DIE,DA,DR,X,Y,IBA,IBFOUND,IBATFN,IBNUM,IBAT,IBFN

 ;

 S IBA(1)="      >> Adding 'Service Connected' Billable Appointment Type (#352.1)"

 ;

 S (IBATFN,IBNUM)=11,IBAT="SERVICE CONNECTED"

 ;

 S IBFOUND=$G(^IBE(352.1,IBATFN,0))

 ;

 I $P(IBFOUND,U,1,3)="11^11^2880101" D MSG("         Done.  Billable Appointment Type Already Exists") G ATADDQ

 I IBFOUND'="" D MSG(" "),MSG("     *** ERROR: Entry already Exists, could not add") G ATADDQ

 I +$O(^IBE(352.1,"B",IBNUM,0)) D MSG(" "),MSG("     *** ERROR: Number already Exists, could not add") G ATADDQ

 ; 

 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

 I Y<1 K X,Y D MSG(" "),MSG("     *** ERROR: New Entry could not be added") G ATADDQ

 ;

 S DR=".02///"_IBAT_";.03////2880101;.04///NO;.05///YES;.06///YES"

 S DIE="^IBE(352.1,",DA=+IBFN D ^DIE K DIE,DA,DR,X,Y

 ;

 D MSG("         Done. Service Connected Billable Appointment Type Added")

 ;

ATADDQ D MES^XPDUTL(.IBA) K IBA

 Q

 ;

 ;

MSG(X) ;

 N IBX S IBX=$O(IBA(999999),-1) S:'IBX IBX=1 S IBX=IBX+1

 S IBA(IBX)=$G(X)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IB20P318   1723     printed  Apr 09, 2024@21:29:40                                                                                                                                                                                                    Page 2

IB20P318  ;ALB/ARH - IB*2.0*318 POST INIT: ADD BILLABLE APPT TYPE ; 23-JUN-2005

 +1       ;;2.0;INTEGRATED BILLING;**318**;21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4       ;

 +5        QUIT 

 +6       ;

POST      ;

 +1        NEW IBA

 +2        SET IBA(1)=""

           SET IBA(2)="    IB*2*318 Post-Install ....."

           SET IBA(3)=""

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +3       ;

 +4       ; Add New Billable Appointment Type

           DO ATADD

 +5       ;

 +6        SET IBA(1)=""

           SET IBA(2)="    IB*2*318 Post-Install Complete"

           SET IBA(3)=""

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +7       ;

 +8        QUIT 

 +9       ;

 +10      ;

 +11      ;

ATADD     ; New Billable Appointment Type (352.1) to correspond to the New 'SERVICE CONNECTED' Appointment Type (409.1)

 +1        NEW DD,DO,DLAYGO,DINUM,DIC,DIE,DA,DR,X,Y,IBA,IBFOUND,IBATFN,IBNUM,IBAT,IBFN

 +2       ;

 +3        SET IBA(1)="      >> Adding 'Service Connected' Billable Appointment Type (#352.1)"

 +4       ;

 +5        SET (IBATFN,IBNUM)=11

           SET IBAT="SERVICE CONNECTED"

 +6       ;

 +7        SET IBFOUND=$GET(^IBE(352.1,IBATFN,0))

 +8       ;

 +9        IF $PIECE(IBFOUND,U,1,3)="11^11^2880101"

               DO MSG("         Done.  Billable Appointment Type Already Exists")

               GOTO ATADDQ

 +10       IF IBFOUND'=""

               DO MSG(" ")

               DO MSG("     *** ERROR: Entry already Exists, could not add")

               GOTO ATADDQ

 +11       IF +$ORDER(^IBE(352.1,"B",IBNUM,0))

               DO MSG(" ")

               DO MSG("     *** ERROR: Number already Exists, could not add")

               GOTO ATADDQ

 +12      ; 

 +13       KILL DD,DO

           SET DINUM=IBATFN

           SET DLAYGO=352.1

           SET DIC="^IBE(352.1,"

           SET DIC(0)="L"

           SET X=IBATFN

           DO FILE^DICN

           KILL DIC

           SET IBFN=+Y

 +14       IF Y<1

               KILL X,Y

               DO MSG(" ")

               DO MSG("     *** ERROR: New Entry could not be added")

               GOTO ATADDQ

 +15      ;

 +16       SET DR=".02///"_IBAT_";.03////2880101;.04///NO;.05///YES;.06///YES"

 +17       SET DIE="^IBE(352.1,"

           SET DA=+IBFN

           DO ^DIE

           KILL DIE,DA,DR,X,Y

 +18      ;

 +19       DO MSG("         Done. Service Connected Billable Appointment Type Added")

 +20      ;

ATADDQ     DO MES^XPDUTL(.IBA)

           KILL IBA

 +1        QUIT 

 +2       ;

 +3       ;

MSG(X)    ;

 +1        NEW IBX

           SET IBX=$ORDER(IBA(999999),-1)

           if 'IBX

               SET IBX=1

           SET IBX=IBX+1

 +2        SET IBA(IBX)=$GET(X)

 +3        QUIT