- IB20P543 ;ALB/CXW - UPDATE MCCR UTILITY & REVENUE & POS ; 01/22/2015
- ;;2.0;INTEGRATED BILLING;**543**;21-MAR-94;Build 20
- ;;Per VA Directive 6402, this routine should not be modified.
- Q
- POST ;
- ; Update value/occurrence/condition codes in mccr utility file 399.1
- ; Update revenue codes in revenue code file 399.2
- ; Update pos code in place of service file 353.1
- N IBZ,U S U="^"
- D MSG(" IB*2.0*543 Post-Install starts .....")
- D MCR,RVC,POS,FORM
- D MSG(" IB*2.0*543 Post-Install is complete.")
- Q
- ;
- MCR ; 3 types of codes
- N IBCNT,IBCOD,IBPE,IBFD,IBFD2,IBI,IBX S IBFD2=""
- ; Value code flag in field #.18/piece 11
- S IBCNT=0,IBPE=11,IBFD=.18
- D MSG(" >>>Value Code")
- F IBI=1:1 S IBX=$P($T(VALU+IBI),";;",2) Q:IBX="Q" D MFILE
- ;
- ; Condition code flag in field #.22/piece 15
- S IBPE=15,IBFD=.22
- D MSG(""),MSG(" >>>Condition Code")
- F IBI=1:1 S IBX=$P($T(CONU+IBI),";;",2) Q:IBX="Q" D MFILE
- ;
- ; Occurrence span code flag in fields #.11/piece 4, #.17/piece 10
- S IBPE=4,IBFD=.11,IBFD2=.17
- D MSG(""),MSG(" >>>Occurrence Span Code")
- F IBI=1:1 S IBX=$P($T(OCCPU+IBI),";;",2) Q:IBX="Q" D MFILE
- ;
- D MSG("Total "_IBCNT_" code"_$S(IBCNT'=1:"s",1:"")_" updated in the MCCR Utility file (#399.1)")
- Q
- ;
- MFILE ; store in mccr utility file
- N IBA,IBB,IBFN,IBFLG,IBMS,IBX3,DLAYGO,DIC,DIE,DA,DD,DO,DR,X,Y
- S (IBMS,IBX3)="",IBA=$P(IBX,U),IBB=$P(IBX,U,2),IBFLG=$P(IBX,U,3)
- S IBFN=+$$EXCODE(IBA,IBPE) S:IBFN IBX3=$G(^DGCR(399.1,IBFN,0))
- I $P(IBX3,U,1)=IBB,$P(IBX3,U,2)=IBA S IBMS="not "_$S('IBFLG:"added",1:"updated") G MFILEQ
- I 'IBFLG D
- . S DLAYGO=399.1,DIC="^DGCR(399.1,",DIC(0)="L",X=IBB D FILE^DICN
- . I Y<1 D MSG(" >> ERROR when adding "_$S(IBPE=11:"Value",IBPE=15:"Condition",1:"Occurrence Span")_" Code #"_IBA_" to the file, Log a Remedy ticket!") Q
- . S DA=+Y,DIE=DIC,DR=".02///"_IBA_";"_IBFD_"///"_1 D ^DIE
- . S IBMS="added",IBCNT=IBCNT+1
- I IBFLG D
- . S:IBA="A0" IBFN=+$$EXCODE("RAO",IBPE)
- . S DIE="^DGCR(399.1,",DA=IBFN,DR=".01///"_IBB_";.02///"_$S(IBA="A0":IBA,1:"") D ^DIE
- . S IBMS="updated",IBCNT=IBCNT+1
- MFILEQ I IBMS'="" D MSG(" #"_IBA_" "_IBB_" "_IBMS)
- Q
- ;
- EXCODE(IBCOD,IBPE) ; Returns IEN if code found in the IBPE piece
- N IBX,IBY S IBY=""
- I $G(IBCOD)'="" S IBX=0 F S IBX=$O(^DGCR(399.1,"C",IBCOD,IBX)) Q:'IBX I $P($G(^DGCR(399.1,IBX,0)),U,+$G(IBPE)) S IBY=IBX
- Q IBY
- ;
- RVC ; Revenue code in fields #1/piece 2, #3/piece 4
- N IBA,IBB,IBC,IBCNT,IBFLG,IBINA,IBI,IBX,IBY,IBX3,DA,DD,DO,DIE,DR,X,Y
- S IBCNT=0
- D MSG(""),MSG(" >>>Revenue Code")
- F IBI=1:1 S IBX=$P($T(RVCU+IBI),";;",2) Q:IBX="Q" S IBMS="" D
- . S IBA=$P(IBX,U),IBB=$P(IBX,U,2),IBC=$P(IBX,U,3)
- . S IBFLG=$P(IBX,U,4),IBINA=$P(IBX,U,5)
- . S IBY=+$O(^DGCR(399.2,"B",IBA,0)) Q:'IBY
- . S IBX3=$G(^DGCR(399.2,IBY,0))
- . I 'IBFLG,'IBINA,$P(IBX3,U)=IBA,$P(IBX3,U,2)=IBB S IBMS="not added" G RVCQ
- . I IBINA,$P(IBX3,U)=IBA,'$P(IBX3,U,3) S IBMS="not inactivated" G RVCQ
- . I IBFLG,$P(IBX3,U)=IBA,$P(IBX3,U,2)=IBB,$P(IBX3,U,4)=IBC S IBMS="not updated" G RVCQ
- . ;
- . ;4 slashes to override the letter '*'
- . I 'IBINA S DR="1////"_IBB_";3////"_IBC_";2///"_$S(IBB="*RESERVED":0,1:1),IBMS=$S(IBFLG:"updated",1:"added")
- . I IBINA S DR="2///0",IBMS="inactivated"
- . S DIE="^DGCR(399.2,",DA=+IBY D ^DIE
- . S IBCNT=IBCNT+1
- RVCQ . I IBMS'="" D MSG(" #"_IBA_" "_IBC_" "_IBMS)
- D MSG("Total "_IBCNT_" code"_$S(IBCNT'=1:"s",1:"")_" updated in the Revenue file (#399.2)")
- Q
- ;
- POS ; Place Of Service in fields #.01/piece 1, #.02/piece 2, #.03/piece 3
- N IBA,IBB,IBC,IBCNT,IBFLG,IBI,IBMS,IBX,IBX3,IBY,DA,DIC,DIE,DIK,DLAYGO,DD,DO,DR,X,Y
- S IBCNT=0,IBX3=""
- D MSG(""),MSG(" >>>Place of Service Code")
- F IBI=1:1 S IBX=$P($T(POSU+IBI),";;",2) Q:IBX="Q" S IBMS="" D
- . S IBA=$P(IBX,U,1),IBB=$P(IBX,U,2)
- . S IBC=$P(IBX,U,3),IBFLG=$P(IBX,U,4)
- . S IBY=+$O(^IBE(353.1,"B",IBA,0))
- . S:IBY IBX3=$G(^IBE(353.1,IBY,0))
- . I IBFLG D
- .. I 'IBY S IBMS="not removed" Q
- .. S DIK="^IBE(353.1," S DA=+IBY D ^DIK
- .. S IBCNT=IBCNT+1,IBMS="removed"
- . I 'IBFLG D
- .. I IBY,$P(IBX3,U)=IBA,$P(IBX3,U,2)=IBB S IBMS="not added" Q
- .. S DLAYGO=353.1,DIC="^IBE(353.1,",DIC(0)="L",X=IBA D FILE^DICN
- .. I Y<1 K X,Y D MSG(" >> ERROR when adding #"_IBA_" "_IBB_" to the file, Log a Remedy ticket!") Q
- .. S DA=+Y,DIE=DIC,DR=".02///"_IBB_";.03///"_IBC D ^DIE
- .. S IBCNT=IBCNT+1,IBMS="added"
- . I IBMS'="" D MSG(" #"_IBA_" "_IBB_" "_IBMS)
- D MSG("Total "_IBCNT_" code"_$S(IBCNT'=1:"s",1:"")_" updated in the Place of Service file (#353.1)")
- D MSG("")
- Q
- ;
- FORM ; 364.6 entry modified to increase the length in field #.9/piece 9
- N IBCNT,IBA,IBB,DA,DIE,DR,X,Y
- D MSG(" >>>Output Formatter Entry")
- S IBA=1682,IBB="OTHER PROC DATE 5 (FL-74E/2)",IBCNT=0
- I '$D(^IBA(364.6,IBA)) D MSG(" >> #"_IBA_" "_IBB_" not defined in file (#364.6)") G FORMQ
- I $P(^IBA(364.6,IBA,0),U,9)=7 D MSG(" #"_IBA_" "_IBB_" not updated") G FORMQ
- S DIE="^IBA(364.6,",DA=IBA,DR=".09///7" D ^DIE
- S IBCNT=IBCNT+1
- D MSG(" #"_IBA_" "_IBB_" updated")
- FORMQ D MSG("Total "_IBCNT_" code"_$S(IBCNT'=1:"s",1:"")_" updated in the IB Form Skeleton Definition file (#364.6)")
- Q
- ;
- MSG(IBZ) ;
- D MES^XPDUTL(IBZ) Q
- ;
- RVCU ; Revenue code^standard abbreviation^description^update^inactivate (24)
- ;;139^OTHER^OTHER^1
- ;;175^*RESERVED^*RESERVED^1
- ;;599^*RESERVED^*RESERVED^1
- ;;630^*RESERVED^*RESERVED^1
- ;;680^*RESERVED^*RESERVED^1
- ;;690^PRE-HOSPICE/PALLIATIVE CARE SERVICES^GENERAL CLASSIFICATION-PRE-HOSPICE/PALLIATIVE CARE SERVICES
- ;;691^VISIT CHARGE^VISIT CHARGE
- ;;692^HOURLY CHARGE^HOURLY CHARGE
- ;;693^EVALUATION^EVALUATION
- ;;694^CONSULTATION AND EDUCATION^CONSULTATION AND EDUCATION
- ;;695^INPATIENT CARE^INPATIENT CARE
- ;;696^PHYSICIAN SERVICES^PHYSICIAN SERVICES
- ;;699^OTHER^OTHER
- ;;779^*RESERVED^*RESERVED^1
- ;;789^TELEMEDICINE/OTHER^OTHER TELEMEDICINE^^1
- ;;815^HEART/CADAVER^CADAVER DONOR-HEART^^1
- ;;816^HEART/OTHER^OTHER HEART ACQUISITION^^1
- ;;817^LIVER ACQUISIT^DONOR-LIVER^^1
- ;;890^*RESERVED^*RESERVED^1
- ;;891^DONOR BANK/BONE^BONE^^1
- ;;892^DONOR BANK/ORGAN^ORGAN (OTHER THAN KIDNEY)^^1
- ;;893^DONOR BANK/SKIN^SKIN^^1
- ;;899^OTHER DONOR BANK^OTHER DONOR BANK^^1
- ;;970^*RESERVED^*RESERVED^1
- ;;Q
- ;
- VALU ; Value code^name^update (9)
- ;;E1^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- ;;E2^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- ;;E3^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- ;;F1^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- ;;F2^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- ;;F3^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- ;;G1^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- ;;G2^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- ;;G3^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- ;;Q
- ;
- CONU ; Condition code^name^update (11)
- ;;55^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- ;;A0^TRICARE EXTERNAL PARTNERSHIP PROGRAM^1
- ;;R1^REG FOR REOPN RSN CODE-MATH OR COMPUTE MISTAKES
- ;;R2^REG FOR REOPN RSN CODE-INACCURATE DATA ENTRY
- ;;R3^REG FOR REOPN RSN CODE-MISAPPLICATION OF A FREE SCHEDULE
- ;;R4^REG FOR REOPN RSN CODE-COMPUTER ERRORS
- ;;R5^REG FOR REOPN RSN CODE-INCORRECT IDENTIFY DUPLICATE CLAIM
- ;;R6^REG FPR REOPN RSN CODE-OTH CLER ERR OMIT NOT SPEC IN R1-R5
- ;;R7^REG FOR REOPN CODE-CORRECT OTHER THAN CLERICAL ERRORS
- ;;R8^REG FOR REOPN CODE-NEW AND MATERIAL EVIDENCE
- ;;R9^REG FOR REOPN CODE-FAULTY EVIDENCE
- ;;Q
- ;
- OCCPU ; Occurrence span code^name^update (11)
- ;;70^RESERVED FOR OCCURRENCE SPAN CODES^1
- ;;71^RESERVED FOR OCCURRENCE SPAN CODES^1
- ;;72^RESERVED FOR OCCURRENCE SPAN CODES^1
- ;;73^RESERVED FOR OCCURRENCE SPAN CODES^1
- ;;74^RESERVED FOR OCCURRENCE SPAN CODES^1
- ;;75^RESERVED FOR OCCURRENCE SPAN CODES^1
- ;;76^RESERVED FOR OCCURRENCE SPAN CODES^1
- ;;77^RESERVED FOR OCCURRENCE SPAN CODES^1
- ;;78^RESERVED FOR OCCURRENCE SPAN CODES^1
- ;;79^RESERVED FOR OCCURRENCE SPAN CODES^1
- ;;80^RESERVED FOR OCCURRENCE SPAN CODES^1
- ;;Q
- ;
- POSU ; Place of Service code^name^abbreviation^remove (3)
- ;;18^PLACE OF EMPLOYMENT-WORKSITE^EMPLOYMENT-WORKSITE
- ;;GR^NATURE OF INJURY (NCCI)^NATURE OF INJURY (NCCI)^1
- ;;NI^NATURE OF INJURY^NATURE OF INJURY^1
- ;;Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P543 8056 printed Feb 18, 2025@23:29:59 Page 2
- IB20P543 ;ALB/CXW - UPDATE MCCR UTILITY & REVENUE & POS ; 01/22/2015
- +1 ;;2.0;INTEGRATED BILLING;**543**;21-MAR-94;Build 20
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- POST ;
- +1 ; Update value/occurrence/condition codes in mccr utility file 399.1
- +2 ; Update revenue codes in revenue code file 399.2
- +3 ; Update pos code in place of service file 353.1
- +4 NEW IBZ,U
- SET U="^"
- +5 DO MSG(" IB*2.0*543 Post-Install starts .....")
- +6 DO MCR
- DO RVC
- DO POS
- DO FORM
- +7 DO MSG(" IB*2.0*543 Post-Install is complete.")
- +8 QUIT
- +9 ;
- MCR ; 3 types of codes
- +1 NEW IBCNT,IBCOD,IBPE,IBFD,IBFD2,IBI,IBX
- SET IBFD2=""
- +2 ; Value code flag in field #.18/piece 11
- +3 SET IBCNT=0
- SET IBPE=11
- SET IBFD=.18
- +4 DO MSG(" >>>Value Code")
- +5 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(VALU+IBI),";;",2)
- if IBX="Q"
- QUIT
- DO MFILE
- +6 ;
- +7 ; Condition code flag in field #.22/piece 15
- +8 SET IBPE=15
- SET IBFD=.22
- +9 DO MSG("")
- DO MSG(" >>>Condition Code")
- +10 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(CONU+IBI),";;",2)
- if IBX="Q"
- QUIT
- DO MFILE
- +11 ;
- +12 ; Occurrence span code flag in fields #.11/piece 4, #.17/piece 10
- +13 SET IBPE=4
- SET IBFD=.11
- SET IBFD2=.17
- +14 DO MSG("")
- DO MSG(" >>>Occurrence Span Code")
- +15 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(OCCPU+IBI),";;",2)
- if IBX="Q"
- QUIT
- DO MFILE
- +16 ;
- +17 DO MSG("Total "_IBCNT_" code"_$SELECT(IBCNT'=1:"s",1:"")_" updated in the MCCR Utility file (#399.1)")
- +18 QUIT
- +19 ;
- MFILE ; store in mccr utility file
- +1 NEW IBA,IBB,IBFN,IBFLG,IBMS,IBX3,DLAYGO,DIC,DIE,DA,DD,DO,DR,X,Y
- +2 SET (IBMS,IBX3)=""
- SET IBA=$PIECE(IBX,U)
- SET IBB=$PIECE(IBX,U,2)
- SET IBFLG=$PIECE(IBX,U,3)
- +3 SET IBFN=+$$EXCODE(IBA,IBPE)
- if IBFN
- SET IBX3=$GET(^DGCR(399.1,IBFN,0))
- +4 IF $PIECE(IBX3,U,1)=IBB
- IF $PIECE(IBX3,U,2)=IBA
- SET IBMS="not "_$SELECT('IBFLG:"added",1:"updated")
- GOTO MFILEQ
- +5 IF 'IBFLG
- Begin DoDot:1
- +6 SET DLAYGO=399.1
- SET DIC="^DGCR(399.1,"
- SET DIC(0)="L"
- SET X=IBB
- DO FILE^DICN
- +7 IF Y<1
- DO MSG(" >> ERROR when adding "_$SELECT(IBPE=11:"Value",IBPE=15:"Condition",1:"Occurrence Span")_" Code #"_IBA_" to the file, Log a Remedy ticket!")
- QUIT
- +8 SET DA=+Y
- SET DIE=DIC
- SET DR=".02///"_IBA_";"_IBFD_"///"_1
- DO ^DIE
- +9 SET IBMS="added"
- SET IBCNT=IBCNT+1
- End DoDot:1
- +10 IF IBFLG
- Begin DoDot:1
- +11 if IBA="A0"
- SET IBFN=+$$EXCODE("RAO",IBPE)
- +12 SET DIE="^DGCR(399.1,"
- SET DA=IBFN
- SET DR=".01///"_IBB_";.02///"_$SELECT(IBA="A0":IBA,1:"")
- DO ^DIE
- +13 SET IBMS="updated"
- SET IBCNT=IBCNT+1
- End DoDot:1
- MFILEQ IF IBMS'=""
- DO MSG(" #"_IBA_" "_IBB_" "_IBMS)
- +1 QUIT
- +2 ;
- EXCODE(IBCOD,IBPE) ; Returns IEN if code found in the IBPE piece
- +1 NEW IBX,IBY
- SET IBY=""
- +2 IF $GET(IBCOD)'=""
- SET IBX=0
- FOR
- SET IBX=$ORDER(^DGCR(399.1,"C",IBCOD,IBX))
- if 'IBX
- QUIT
- IF $PIECE($GET(^DGCR(399.1,IBX,0)),U,+$GET(IBPE))
- SET IBY=IBX
- +3 QUIT IBY
- +4 ;
- RVC ; Revenue code in fields #1/piece 2, #3/piece 4
- +1 NEW IBA,IBB,IBC,IBCNT,IBFLG,IBINA,IBI,IBX,IBY,IBX3,DA,DD,DO,DIE,DR,X,Y
- +2 SET IBCNT=0
- +3 DO MSG("")
- DO MSG(" >>>Revenue Code")
- +4 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(RVCU+IBI),";;",2)
- if IBX="Q"
- QUIT
- SET IBMS=""
- Begin DoDot:1
- +5 SET IBA=$PIECE(IBX,U)
- SET IBB=$PIECE(IBX,U,2)
- SET IBC=$PIECE(IBX,U,3)
- +6 SET IBFLG=$PIECE(IBX,U,4)
- SET IBINA=$PIECE(IBX,U,5)
- +7 SET IBY=+$ORDER(^DGCR(399.2,"B",IBA,0))
- if 'IBY
- QUIT
- +8 SET IBX3=$GET(^DGCR(399.2,IBY,0))
- +9 IF 'IBFLG
- IF 'IBINA
- IF $PIECE(IBX3,U)=IBA
- IF $PIECE(IBX3,U,2)=IBB
- SET IBMS="not added"
- GOTO RVCQ
- +10 IF IBINA
- IF $PIECE(IBX3,U)=IBA
- IF '$PIECE(IBX3,U,3)
- SET IBMS="not inactivated"
- GOTO RVCQ
- +11 IF IBFLG
- IF $PIECE(IBX3,U)=IBA
- IF $PIECE(IBX3,U,2)=IBB
- IF $PIECE(IBX3,U,4)=IBC
- SET IBMS="not updated"
- GOTO RVCQ
- +12 ;
- +13 ;4 slashes to override the letter '*'
- +14 IF 'IBINA
- SET DR="1////"_IBB_";3////"_IBC_";2///"_$SELECT(IBB="*RESERVED":0,1:1)
- SET IBMS=$SELECT(IBFLG:"updated",1:"added")
- +15 IF IBINA
- SET DR="2///0"
- SET IBMS="inactivated"
- +16 SET DIE="^DGCR(399.2,"
- SET DA=+IBY
- DO ^DIE
- +17 SET IBCNT=IBCNT+1
- RVCQ IF IBMS'=""
- DO MSG(" #"_IBA_" "_IBC_" "_IBMS)
- End DoDot:1
- +1 DO MSG("Total "_IBCNT_" code"_$SELECT(IBCNT'=1:"s",1:"")_" updated in the Revenue file (#399.2)")
- +2 QUIT
- +3 ;
- POS ; Place Of Service in fields #.01/piece 1, #.02/piece 2, #.03/piece 3
- +1 NEW IBA,IBB,IBC,IBCNT,IBFLG,IBI,IBMS,IBX,IBX3,IBY,DA,DIC,DIE,DIK,DLAYGO,DD,DO,DR,X,Y
- +2 SET IBCNT=0
- SET IBX3=""
- +3 DO MSG("")
- DO MSG(" >>>Place of Service Code")
- +4 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(POSU+IBI),";;",2)
- if IBX="Q"
- QUIT
- SET IBMS=""
- Begin DoDot:1
- +5 SET IBA=$PIECE(IBX,U,1)
- SET IBB=$PIECE(IBX,U,2)
- +6 SET IBC=$PIECE(IBX,U,3)
- SET IBFLG=$PIECE(IBX,U,4)
- +7 SET IBY=+$ORDER(^IBE(353.1,"B",IBA,0))
- +8 if IBY
- SET IBX3=$GET(^IBE(353.1,IBY,0))
- +9 IF IBFLG
- Begin DoDot:2
- +10 IF 'IBY
- SET IBMS="not removed"
- QUIT
- +11 SET DIK="^IBE(353.1,"
- SET DA=+IBY
- DO ^DIK
- +12 SET IBCNT=IBCNT+1
- SET IBMS="removed"
- End DoDot:2
- +13 IF 'IBFLG
- Begin DoDot:2
- +14 IF IBY
- IF $PIECE(IBX3,U)=IBA
- IF $PIECE(IBX3,U,2)=IBB
- SET IBMS="not added"
- QUIT
- +15 SET DLAYGO=353.1
- SET DIC="^IBE(353.1,"
- SET DIC(0)="L"
- SET X=IBA
- DO FILE^DICN
- +16 IF Y<1
- KILL X,Y
- DO MSG(" >> ERROR when adding #"_IBA_" "_IBB_" to the file, Log a Remedy ticket!")
- QUIT
- +17 SET DA=+Y
- SET DIE=DIC
- SET DR=".02///"_IBB_";.03///"_IBC
- DO ^DIE
- +18 SET IBCNT=IBCNT+1
- SET IBMS="added"
- End DoDot:2
- +19 IF IBMS'=""
- DO MSG(" #"_IBA_" "_IBB_" "_IBMS)
- End DoDot:1
- +20 DO MSG("Total "_IBCNT_" code"_$SELECT(IBCNT'=1:"s",1:"")_" updated in the Place of Service file (#353.1)")
- +21 DO MSG("")
- +22 QUIT
- +23 ;
- FORM ; 364.6 entry modified to increase the length in field #.9/piece 9
- +1 NEW IBCNT,IBA,IBB,DA,DIE,DR,X,Y
- +2 DO MSG(" >>>Output Formatter Entry")
- +3 SET IBA=1682
- SET IBB="OTHER PROC DATE 5 (FL-74E/2)"
- SET IBCNT=0
- +4 IF '$DATA(^IBA(364.6,IBA))
- DO MSG(" >> #"_IBA_" "_IBB_" not defined in file (#364.6)")
- GOTO FORMQ
- +5 IF $PIECE(^IBA(364.6,IBA,0),U,9)=7
- DO MSG(" #"_IBA_" "_IBB_" not updated")
- GOTO FORMQ
- +6 SET DIE="^IBA(364.6,"
- SET DA=IBA
- SET DR=".09///7"
- DO ^DIE
- +7 SET IBCNT=IBCNT+1
- +8 DO MSG(" #"_IBA_" "_IBB_" updated")
- FORMQ DO MSG("Total "_IBCNT_" code"_$SELECT(IBCNT'=1:"s",1:"")_" updated in the IB Form Skeleton Definition file (#364.6)")
- +1 QUIT
- +2 ;
- MSG(IBZ) ;
- +1 DO MES^XPDUTL(IBZ)
- QUIT
- +2 ;
- RVCU ; Revenue code^standard abbreviation^description^update^inactivate (24)
- +1 ;;139^OTHER^OTHER^1
- +2 ;;175^*RESERVED^*RESERVED^1
- +3 ;;599^*RESERVED^*RESERVED^1
- +4 ;;630^*RESERVED^*RESERVED^1
- +5 ;;680^*RESERVED^*RESERVED^1
- +6 ;;690^PRE-HOSPICE/PALLIATIVE CARE SERVICES^GENERAL CLASSIFICATION-PRE-HOSPICE/PALLIATIVE CARE SERVICES
- +7 ;;691^VISIT CHARGE^VISIT CHARGE
- +8 ;;692^HOURLY CHARGE^HOURLY CHARGE
- +9 ;;693^EVALUATION^EVALUATION
- +10 ;;694^CONSULTATION AND EDUCATION^CONSULTATION AND EDUCATION
- +11 ;;695^INPATIENT CARE^INPATIENT CARE
- +12 ;;696^PHYSICIAN SERVICES^PHYSICIAN SERVICES
- +13 ;;699^OTHER^OTHER
- +14 ;;779^*RESERVED^*RESERVED^1
- +15 ;;789^TELEMEDICINE/OTHER^OTHER TELEMEDICINE^^1
- +16 ;;815^HEART/CADAVER^CADAVER DONOR-HEART^^1
- +17 ;;816^HEART/OTHER^OTHER HEART ACQUISITION^^1
- +18 ;;817^LIVER ACQUISIT^DONOR-LIVER^^1
- +19 ;;890^*RESERVED^*RESERVED^1
- +20 ;;891^DONOR BANK/BONE^BONE^^1
- +21 ;;892^DONOR BANK/ORGAN^ORGAN (OTHER THAN KIDNEY)^^1
- +22 ;;893^DONOR BANK/SKIN^SKIN^^1
- +23 ;;899^OTHER DONOR BANK^OTHER DONOR BANK^^1
- +24 ;;970^*RESERVED^*RESERVED^1
- +25 ;;Q
- +26 ;
- VALU ; Value code^name^update (9)
- +1 ;;E1^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- +2 ;;E2^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- +3 ;;E3^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- +4 ;;F1^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- +5 ;;F2^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- +6 ;;F3^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- +7 ;;G1^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- +8 ;;G2^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- +9 ;;G3^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- +10 ;;Q
- +11 ;
- CONU ; Condition code^name^update (11)
- +1 ;;55^RESERVED FOR ASSIGNMENT BY THE NUBC^1
- +2 ;;A0^TRICARE EXTERNAL PARTNERSHIP PROGRAM^1
- +3 ;;R1^REG FOR REOPN RSN CODE-MATH OR COMPUTE MISTAKES
- +4 ;;R2^REG FOR REOPN RSN CODE-INACCURATE DATA ENTRY
- +5 ;;R3^REG FOR REOPN RSN CODE-MISAPPLICATION OF A FREE SCHEDULE
- +6 ;;R4^REG FOR REOPN RSN CODE-COMPUTER ERRORS
- +7 ;;R5^REG FOR REOPN RSN CODE-INCORRECT IDENTIFY DUPLICATE CLAIM
- +8 ;;R6^REG FPR REOPN RSN CODE-OTH CLER ERR OMIT NOT SPEC IN R1-R5
- +9 ;;R7^REG FOR REOPN CODE-CORRECT OTHER THAN CLERICAL ERRORS
- +10 ;;R8^REG FOR REOPN CODE-NEW AND MATERIAL EVIDENCE
- +11 ;;R9^REG FOR REOPN CODE-FAULTY EVIDENCE
- +12 ;;Q
- +13 ;
- OCCPU ; Occurrence span code^name^update (11)
- +1 ;;70^RESERVED FOR OCCURRENCE SPAN CODES^1
- +2 ;;71^RESERVED FOR OCCURRENCE SPAN CODES^1
- +3 ;;72^RESERVED FOR OCCURRENCE SPAN CODES^1
- +4 ;;73^RESERVED FOR OCCURRENCE SPAN CODES^1
- +5 ;;74^RESERVED FOR OCCURRENCE SPAN CODES^1
- +6 ;;75^RESERVED FOR OCCURRENCE SPAN CODES^1
- +7 ;;76^RESERVED FOR OCCURRENCE SPAN CODES^1
- +8 ;;77^RESERVED FOR OCCURRENCE SPAN CODES^1
- +9 ;;78^RESERVED FOR OCCURRENCE SPAN CODES^1
- +10 ;;79^RESERVED FOR OCCURRENCE SPAN CODES^1
- +11 ;;80^RESERVED FOR OCCURRENCE SPAN CODES^1
- +12 ;;Q
- +13 ;
- POSU ; Place of Service code^name^abbreviation^remove (3)
- +1 ;;18^PLACE OF EMPLOYMENT-WORKSITE^EMPLOYMENT-WORKSITE
- +2 ;;GR^NATURE OF INJURY (NCCI)^NATURE OF INJURY (NCCI)^1
- +3 ;;NI^NATURE OF INJURY^NATURE OF INJURY^1
- +4 ;;Q
- +5 ;