- IBYSA ;ALB/ARH - IB*2.0*122 POST INIT: HCFA 1500 DATE LENGTHS ; 10-OCT-1998
- ;;2.0;INTEGRATED BILLING;**122**;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*122 Post-Install:",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
- ;
- D HDATES ; update width of HCFA 1500 date fields
- ;
- S IBA(1)="",IBA(2)=" IB*2*122 Post-Install Complete.",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
- ;
- Q
- ;
- HDATES ; update width of HCFA 1500 date fields to 10 characters to accomodate 4 digit years
- N DA,DIE,DIC,DR,IBCNT,IBX,IBA S IBCNT=0
- ;
- S IBA(1)=" Expand HCFA 1500 Date fields to 10 characters (364.6)",IBA(2)=" "
- ;
- S DA=+$O(^IBA(364.6,"ASEQ",2,1,11,31,0)) ; 497 - PATIENT DOB (BX-3/1)
- I +DA S DIE="^IBA(364.6,",DR=".09////10" D ^DIE S IBCNT=IBCNT+1 D MSG2(DA)
- ;
- S DA=+$O(^IBA(364.6,"ASEQ",2,1,21,54,0)) ; 520 - INSUREDS DOB (BX-11A/1)
- I +DA S DIE="^IBA(364.6,",DR=".09////10" D ^DIE S IBCNT=IBCNT+1 D MSG2(DA)
- ;
- S DA=+$O(^IBA(364.6,"ASEQ",2,1,23,2,0)) ; 523 - OTH INSURED DOB (BX-9B/1)
- I +DA S DIE="^IBA(364.6,",DR=".09////10" D ^DIE S IBCNT=IBCNT+1 D MSG2(DA)
- ;
- S DA=+$O(^IBA(364.6,"ASEQ",2,1,33,2,0)) ; 539 - DATE OF CURR ILLNESS (BX-14)
- I +DA S DIE="^IBA(364.6,",DR=".09////10" D ^DIE S IBCNT=IBCNT+1 D MSG2(DA)
- ;
- S DA=+$O(^IBA(364.6,"ASEQ",2,1,33,37,0)) ; 540 - DATE OF SIMLAR ILLNESS (BX-15)
- I +DA S DIE="^IBA(364.6,",DR=".09////10" D ^DIE S IBCNT=IBCNT+1 D MSG2(DA)
- ;
- S DA=+$O(^IBA(364.6,"ASEQ",2,1,33,54,0)) ; 541 - DT UNABLE TO WRK FR (BX-16/1)
- I +DA S DIE="^IBA(364.6,",DR=".09////10" D ^DIE S IBCNT=IBCNT+1 D MSG2(DA)
- ;
- S DA=+$O(^IBA(364.6,"ASEQ",2,1,33,68,0)) ; 542 - DT UNABLE TO WRK TO (BX-16/2)
- I +DA S DIE="^IBA(364.6,",DR=".09////10" D ^DIE S IBCNT=IBCNT+1 D MSG2(DA)
- ;
- S DA=+$O(^IBA(364.6,"ASEQ",2,1,35,54,0)) ; 543 - HOSP FROM DATE (BX-18/1)
- I +DA S DIE="^IBA(364.6,",DR=".09////10" D ^DIE S IBCNT=IBCNT+1 D MSG2(DA)
- ;
- S DA=+$O(^IBA(364.6,"ASEQ",2,1,35,68,0)) ; 544 - HOSP TO DATE (BX-18/2)
- I +DA S DIE="^IBA(364.6,",DR=".09////10" D ^DIE S IBCNT=IBCNT+1 D MSG2(DA)
- ;
- D MSG(" "),MSG(" "_IBCNT_" HCFA 1500 date 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[HIBYSA 2443 printed Mar 13, 2025@21:42:10 Page 2
- IBYSA ;ALB/ARH - IB*2.0*122 POST INIT: HCFA 1500 DATE LENGTHS ; 10-OCT-1998
- +1 ;;2.0;INTEGRATED BILLING;**122**;21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;
- +5 QUIT
- POST ;
- +1 NEW IBA
- +2 SET IBA(1)=""
- SET IBA(2)=" IB*2*122 Post-Install:"
- SET IBA(3)=""
- DO MES^XPDUTL(.IBA)
- KILL IBA
- +3 ;
- +4 ; update width of HCFA 1500 date fields
- DO HDATES
- +5 ;
- +6 SET IBA(1)=""
- SET IBA(2)=" IB*2*122 Post-Install Complete."
- SET IBA(3)=""
- DO MES^XPDUTL(.IBA)
- KILL IBA
- +7 ;
- +8 QUIT
- +9 ;
- HDATES ; update width of HCFA 1500 date fields to 10 characters to accomodate 4 digit years
- +1 NEW DA,DIE,DIC,DR,IBCNT,IBX,IBA
- SET IBCNT=0
- +2 ;
- +3 SET IBA(1)=" Expand HCFA 1500 Date fields to 10 characters (364.6)"
- SET IBA(2)=" "
- +4 ;
- +5 ; 497 - PATIENT DOB (BX-3/1)
- SET DA=+$ORDER(^IBA(364.6,"ASEQ",2,1,11,31,0))
- +6 IF +DA
- SET DIE="^IBA(364.6,"
- SET DR=".09////10"
- DO ^DIE
- SET IBCNT=IBCNT+1
- DO MSG2(DA)
- +7 ;
- +8 ; 520 - INSUREDS DOB (BX-11A/1)
- SET DA=+$ORDER(^IBA(364.6,"ASEQ",2,1,21,54,0))
- +9 IF +DA
- SET DIE="^IBA(364.6,"
- SET DR=".09////10"
- DO ^DIE
- SET IBCNT=IBCNT+1
- DO MSG2(DA)
- +10 ;
- +11 ; 523 - OTH INSURED DOB (BX-9B/1)
- SET DA=+$ORDER(^IBA(364.6,"ASEQ",2,1,23,2,0))
- +12 IF +DA
- SET DIE="^IBA(364.6,"
- SET DR=".09////10"
- DO ^DIE
- SET IBCNT=IBCNT+1
- DO MSG2(DA)
- +13 ;
- +14 ; 539 - DATE OF CURR ILLNESS (BX-14)
- SET DA=+$ORDER(^IBA(364.6,"ASEQ",2,1,33,2,0))
- +15 IF +DA
- SET DIE="^IBA(364.6,"
- SET DR=".09////10"
- DO ^DIE
- SET IBCNT=IBCNT+1
- DO MSG2(DA)
- +16 ;
- +17 ; 540 - DATE OF SIMLAR ILLNESS (BX-15)
- SET DA=+$ORDER(^IBA(364.6,"ASEQ",2,1,33,37,0))
- +18 IF +DA
- SET DIE="^IBA(364.6,"
- SET DR=".09////10"
- DO ^DIE
- SET IBCNT=IBCNT+1
- DO MSG2(DA)
- +19 ;
- +20 ; 541 - DT UNABLE TO WRK FR (BX-16/1)
- SET DA=+$ORDER(^IBA(364.6,"ASEQ",2,1,33,54,0))
- +21 IF +DA
- SET DIE="^IBA(364.6,"
- SET DR=".09////10"
- DO ^DIE
- SET IBCNT=IBCNT+1
- DO MSG2(DA)
- +22 ;
- +23 ; 542 - DT UNABLE TO WRK TO (BX-16/2)
- SET DA=+$ORDER(^IBA(364.6,"ASEQ",2,1,33,68,0))
- +24 IF +DA
- SET DIE="^IBA(364.6,"
- SET DR=".09////10"
- DO ^DIE
- SET IBCNT=IBCNT+1
- DO MSG2(DA)
- +25 ;
- +26 ; 543 - HOSP FROM DATE (BX-18/1)
- SET DA=+$ORDER(^IBA(364.6,"ASEQ",2,1,35,54,0))
- +27 IF +DA
- SET DIE="^IBA(364.6,"
- SET DR=".09////10"
- DO ^DIE
- SET IBCNT=IBCNT+1
- DO MSG2(DA)
- +28 ;
- +29 ; 544 - HOSP TO DATE (BX-18/2)
- SET DA=+$ORDER(^IBA(364.6,"ASEQ",2,1,35,68,0))
- +30 IF +DA
- SET DIE="^IBA(364.6,"
- SET DR=".09////10"
- DO ^DIE
- SET IBCNT=IBCNT+1
- DO MSG2(DA)
- +31 ;
- +32 DO MSG(" ")
- DO MSG(" "_IBCNT_" HCFA 1500 date fields updated (364.6)")
- +33 DO MES^XPDUTL(.IBA)
- +34 QUIT
- +35 ;
- 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
