IBYSB ;ALB/ARH - IB*2.0*124 PRE INIT: UPDATE OF #364.6 ; 12/10/99
;;2.0;INTEGRATED BILLING;**124**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
Q
PRE ;
N IBA
S IBA(1)="",IBA(2)=" IB*2*124 Pre-Install:",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
;
D U3646 ; update position/column and length for three fields
;
S IBA(1)="",IBA(2)=" IB*2*124 Pre-Install Complete.",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
;
Q
;
U3646 ; OUTPUT FORMATTER: UPDATE FILE 364.6
N DA,DIE,DIC,DR,IBCNT,IBX,IBA S IBCNT=0
;
S IBA(1)=" Update Output Formatter definition of three UB-92 fields (364.6)",IBA(2)=" "
;
; update length to accomodate all 3 fields
S DA=+$O(^IBA(364.6,"ASEQ",3,1,3,78,0)) ; 618 - LOCATION OF CARE (FL-4,1)
I +DA S DIE="^IBA(364.6,",DR=".09////4" D ^DIE S IBCNT=IBCNT+1 D MSG2(DA)
;
; update STARTING COLUMN OR PIECE (364.6,.08) and delete LENGTH (364.6,.09) for two fields
;
S DA=+$O(^IBA(364.6,"ASEQ",3,1,3,79,0)) ; 763 - BILL CLASSIFICATION (FL-4,2)
I +DA S DIE="^IBA(364.6,",DR=".08////77.5;.09////@" D ^DIE S IBCNT=IBCNT+1 D MSG2(DA)
;
S DA=+$O(^IBA(364.6,"ASEQ",3,1,3,80,0)) ; 764 - TIMEFRAME OF BILL (FL-4,3)
I +DA S DIE="^IBA(364.6,",DR=".08////77.6;.09////@" D ^DIE S IBCNT=IBCNT+1 D MSG2(DA)
;
D MSG(" "),MSG(" "_IBCNT_" fields updated (364.6)")
D MES^XPDUTL(.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
MSG2(X) ; write message on field changed
N Y I +$G(X) S Y=$P($G(^IBA(364.6,X,0)),U,10) D MSG(" "_X_" - "_Y)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYSB 1604 printed Dec 13, 2024@02:36:58 Page 2
IBYSB ;ALB/ARH - IB*2.0*124 PRE INIT: UPDATE OF #364.6 ; 12/10/99
+1 ;;2.0;INTEGRATED BILLING;**124**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
+5 QUIT
PRE ;
+1 NEW IBA
+2 SET IBA(1)=""
SET IBA(2)=" IB*2*124 Pre-Install:"
SET IBA(3)=""
DO MES^XPDUTL(.IBA)
KILL IBA
+3 ;
+4 ; update position/column and length for three fields
DO U3646
+5 ;
+6 SET IBA(1)=""
SET IBA(2)=" IB*2*124 Pre-Install Complete."
SET IBA(3)=""
DO MES^XPDUTL(.IBA)
KILL IBA
+7 ;
+8 QUIT
+9 ;
U3646 ; OUTPUT FORMATTER: UPDATE FILE 364.6
+1 NEW DA,DIE,DIC,DR,IBCNT,IBX,IBA
SET IBCNT=0
+2 ;
+3 SET IBA(1)=" Update Output Formatter definition of three UB-92 fields (364.6)"
SET IBA(2)=" "
+4 ;
+5 ; update length to accomodate all 3 fields
+6 ; 618 - LOCATION OF CARE (FL-4,1)
SET DA=+$ORDER(^IBA(364.6,"ASEQ",3,1,3,78,0))
+7 IF +DA
SET DIE="^IBA(364.6,"
SET DR=".09////4"
DO ^DIE
SET IBCNT=IBCNT+1
DO MSG2(DA)
+8 ;
+9 ; update STARTING COLUMN OR PIECE (364.6,.08) and delete LENGTH (364.6,.09) for two fields
+10 ;
+11 ; 763 - BILL CLASSIFICATION (FL-4,2)
SET DA=+$ORDER(^IBA(364.6,"ASEQ",3,1,3,79,0))
+12 IF +DA
SET DIE="^IBA(364.6,"
SET DR=".08////77.5;.09////@"
DO ^DIE
SET IBCNT=IBCNT+1
DO MSG2(DA)
+13 ;
+14 ; 764 - TIMEFRAME OF BILL (FL-4,3)
SET DA=+$ORDER(^IBA(364.6,"ASEQ",3,1,3,80,0))
+15 IF +DA
SET DIE="^IBA(364.6,"
SET DR=".08////77.6;.09////@"
DO ^DIE
SET IBCNT=IBCNT+1
DO MSG2(DA)
+16 ;
+17 DO MSG(" ")
DO MSG(" "_IBCNT_" fields updated (364.6)")
+18 DO MES^XPDUTL(.IBA)
+19 QUIT
+20 ;
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
MSG2(X) ; write message on field changed
+1 NEW Y
IF +$GET(X)
SET Y=$PIECE($GET(^IBA(364.6,X,0)),U,10)
DO MSG(" "_X_" - "_Y)
+2 QUIT
