- 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 Feb 19, 2025@00:03:28 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
