- IBYP458 ;ALB/ARH - IB*2.0*458 POST INIT: RCBE III UPDATE ; 16-OCT-2012
- ;;2.0;INTEGRATED BILLING;**458**;21-MAR-94;Build 4
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- Q
- PRE ; RCBE III (VF #2) PRE-INSTALL
- ; clean up, delete APRE1 xref (#1) on Insurance Review Authorization Number field (#356.2,.28)
- ;
- N IBA S IBA(2)=" IB*2*458 Pre-Install .....",IBA(1)=" " D MES^XPDUTL(.IBA) K IBA
- ;
- D DELIX^DDMOD(356.2,.28,1)
- S IBA(2)=" >> ^DD(356.2,.28) cross-reference #1 deleted",IBA(1)=" "
- S IBA(3)=" Insurance Review (#356.2) Authorization Number (.28) xref APRE1" D MES^XPDUTL(.IBA) K IBA
- ;
- S IBA(2)=" IB*2*458 Pre-Install Complete",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
- Q
- ;
- ;
- POST ; RCBE III (VF #2) POST-INSTALL
- ;
- N IBA S IBA(2)=" IB*2*458 Post-Install .....",IBA(1)=" " D MES^XPDUTL(.IBA) K IBA
- ;
- D CTRT ; Add 3 Claims Tracking Review Types, New (#356.11)
- D CTDR ; Add 3 Claims Tracking Denial Reasons, New (#356.21)
- ;
- D RNBN ; Add 14 RNBs, new (#356.8)
- D RNBE ; Edit 1 RNB, change name (#356.8)
- ;
- D MOVE ; Copy Insurance Review (#356.2) Authorization and Call Reference Number Data
- ;
- S IBA(2)=" IB*2*458 Post-Install Complete",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
- Q
- ;
- ;
- CTRT ; Add New Claims Tracking Review Types (#356.11)
- N IBI,IBRIEN,IBLN,IBNM,IBCTRT,IBTOT,IBTNC,IBTCH,DIE,DIC,DR,DA,DD,DO,X,Y,DLAYGO,DINUM
- S (IBTOT,IBTNC,IBTCH)=0 S DLAYGO=356.11
- ;
- D MSG("Add 3 Claims Tracking Review Types, New (#356.11) ...",1)
- ;
- F IBI=1:1 S IBLN=$P($T(NRT11+IBI),";;",2,999) Q:'IBLN D
- . ;
- . S IBNM=$P(IBLN,U,4) S IBCTRT=$O(^IBE(356.11,"B",IBNM,0))
- . F IBRIEN=11:1 I '$D(^IBE(356.11,IBRIEN,0)) Q
- . ;
- . S IBTOT=IBTOT+1 I +IBCTRT S IBTNC=IBTNC+1 Q
- . ;
- . S DIC="^IBE(356.11," S DIC("DR")=".02////"_$P(IBLN,U,2)_";.03////"_$P(IBLN,U,3)
- . S DIC(0)="L",X=IBNM,DINUM=IBRIEN D FILE^DICN K DIC I 'Y D MSG(IBNM_" Not Added, ERROR ****") Q
- . S IBTCH=IBTCH+1 D MSG(IBNM_" added")
- ;
- I 'IBTCH D MSG("No Change: "_IBTNC_" of "_IBTOT_" New Review Types Already Exist")
- I +IBTCH D MSG("Updated: "_IBTCH_" of "_IBTOT_" New Review Types Added"_$$LN(IBTNC,"Already Exist"),2)
- Q
- ;
- ;
- CTDR ; Add New Claims Tracking Denial Reasons (#356.21)
- N IBI,IBRIEN,IBLN,IBNM,IBCTDR,IBTOT,IBTNC,IBTCH,DIE,DIC,DR,DA,DD,DO,X,Y,DLAYGO,DINUM
- S (IBTOT,IBTNC,IBTCH)=0 S DLAYGO=356.21
- ;
- D MSG("Add 3 Claims Tracking Denial Reasons, New (#356.21) ...",1)
- ;
- F IBI=1:1 S IBLN=$P($T(NDR21+IBI),";;",2,999) Q:'IBLN D
- . ;
- . S IBNM=$P(IBLN,U,3) S IBCTDR=$O(^IBE(356.21,"B",$E(IBNM,1,30),0))
- . F IBRIEN=8:1 I '$D(^IBE(356.21,IBRIEN,0)) Q
- . ;
- . S IBTOT=IBTOT+1 I +IBCTDR S IBTNC=IBTNC+1 Q
- . ;
- . S DIC="^IBE(356.21," S DIC("DR")=".02////"_$P(IBLN,U,2)
- . S DIC(0)="L",X=IBNM,DINUM=IBRIEN D FILE^DICN K DIC I 'Y D MSG(IBNM_" Not Added, ERROR ****") Q
- . S IBTCH=IBTCH+1 D MSG(IBNM_" added")
- ;
- I 'IBTCH D MSG("No Change: "_IBTNC_" of "_IBTOT_" New Denial Reasons Already Exist")
- I +IBTCH D MSG("Updated: "_IBTCH_" of "_IBTOT_" New Denial Reasons Added"_$$LN(IBTNC,"Already Exist"),2)
- Q
- ;
- ;
- RNBE ; Edit Reasons Not Billable: Rename one existing RNB (356.8,.01)
- N DIE,DIC,DA,DR,X,Y,IBI,IBLN,IBOLD,IBNEW,IBRNB,IBTOT,IBTNC,IBTNF,IBTCH S (IBTOT,IBTNC,IBTNF,IBTCH)=0
- ;
- D MSG("Change 1 Reasons Not Billable (RNB), Name (#356.8, .01) ...",1)
- ;
- F IBI=1:1 S IBLN=$P($T(ERNB8+IBI),";;",2,999) Q:'IBLN D
- . S IBOLD=$P(IBLN,U,2),IBNEW=$P(IBLN,U,3) S IBRNB=$O(^IBE(356.8,"B",IBOLD,0))
- . ;
- . S IBTOT=IBTOT+1
- . I $O(^IBE(356.8,"B",IBNEW,0)) S IBTNC=IBTNC+1 Q
- . I 'IBRNB S IBTNF=IBTNF+1 D MSG(IBOLD_" not found, Error") Q
- . ;
- . N DIE,DIC,X,Y S DA=+IBRNB,DR=".01///"_IBNEW S DIE="^IBE(356.8," D ^DIE K DA,DR
- . S IBTCH=IBTCH+1 D MSG(IBOLD_" changed to "_IBNEW)
- ;
- I 'IBTCH D MSG("No Change: "_IBTNC_" of "_IBTOT_" RNB Names Already Changed"_$$LN(IBTNF,"Not Found"))
- I +IBTCH D MSG("Updated: "_IBTCH_" of "_IBTOT_" RNB Names Updated"_$$LN(IBTNC,"Already Changed")_$$LN(IBTNF,"Not Found"),2)
- Q
- ;
- ;
- RNBN ; Add New Reasons Not Billable (#356.8)
- N IBI,IBRIEN,IBLN,IBNM,IBRNB,IBTOT,IBTNC,IBTCH,DIE,DIC,DR,DA,DD,DO,X,Y,DLAYGO,DINUM
- S (IBTOT,IBTNC,IBTCH)=0 S DLAYGO=356.8
- ;
- D MSG("Add 14 Reasons Not Billable (RNB), New (#356.8) ...",1)
- ;
- F IBI=1:1 S IBLN=$P($T(NRNB8+IBI),";;",2,999) Q:'IBLN D
- . ;
- . S IBNM=$P(IBLN,U,5) S IBRNB=$O(^IBE(356.8,"B",IBNM,0))
- . F IBRIEN=100:1 I '$D(^IBE(356.8,IBRIEN,0)) Q
- . ;
- . S IBTOT=IBTOT+1 I +IBRNB S IBTNC=IBTNC+1 Q
- . ;
- . S DIC="^IBE(356.8," S DIC("DR")=".02////"_$P(IBLN,U,2)_";.03////"_$P(IBLN,U,3)_";.04///"_$P(IBLN,U,4)
- . S DIC(0)="L",X=IBNM,DINUM=IBRIEN D FILE^DICN K DIC I 'Y D MSG(IBNM_" Not Added, ERROR ****") Q
- . S IBTCH=IBTCH+1 D MSG(IBNM_" added")
- ;
- I 'IBTCH D MSG("No Change: "_IBTNC_" of "_IBTOT_" New RNBs Already Exist")
- I +IBTCH D MSG("Updated: "_IBTCH_" of "_IBTOT_" New RNBs Added"_$$LN(IBTNC,"Already Exist"),2)
- Q
- ;
- ;
- MOVE ; Move Insurance Review (#356.2) Call Reference and Authorization Number Data
- ; from old fields/location (.09, .28) to new fields/location (2.01, 2.02)
- N IBTRC,IBTRC0,IBTRC2,IBCOLD,IBAOLD,IBCC1,IBCC2,IBAC1,IBAC2,DIE,DIC,DA,DR,X,Y
- S (IBCC1,IBCC2,IBAC1,IBAC2)=0
- ;
- D MSG("Copy Insurance Review (#356.2) Data to New Field Locations ...",1)
- D MSG("Searching file for data to copy, "_+$P($G(^IBT(356.2,0)),U,4)_" entries, please wait ...")
- ;
- S IBTRC=0 F S IBTRC=$O(^IBT(356.2,IBTRC)) Q:'IBTRC D
- . S IBTRC0=$G(^IBT(356.2,IBTRC,0)),IBCOLD=$P(IBTRC0,U,9),IBAOLD=$P(IBTRC0,U,28)
- . S IBTRC2=$G(^IBT(356.2,IBTRC,2)),DR=""
- . ;
- . I IBCOLD'="" S IBCC1=IBCC1+1 I $P(IBTRC2,U,1)="" S DR=DR_"2.01////^S X=IBCOLD;" S IBCC2=IBCC2+1
- . I IBAOLD'="" S IBAC1=IBAC1+1 I $P(IBTRC2,U,2)="" S DR=DR_"2.02////^S X=IBAOLD" S IBAC2=IBAC2+1
- . ;
- . I DR'="" S DIE="^IBT(356.2,",DA=IBTRC D ^DIE K DIE,DIC,DA,DR
- ;
- D MSG(IBCC1_" Call Reference Numbers found (.09), "_IBCC2_" copied (2.01)",2)
- D MSG(IBAC1_" Authorization Numbers found (.28), "_IBAC2_" copied (2.02)")
- Q
- ;
- ;
- ;
- MSG(X,Y) ; set lines into patch install message, X is message, Y is line type (1-header, 2-result line)
- N CNT,IBA S CNT=1,IBA(1)=" " I +$G(Y) S CNT=2,IBA(2)=IBA(1) I +$G(Y)=1 S IBA(2)=" >> "
- S IBA(CNT)=IBA(CNT)_$G(X) D MES^XPDUTL(.IBA) K IBA
- Q
- ;
- LN(NUM,TXT) Q $S('$G(NUM):"",1:", "_$G(NUM)_" "_$G(TXT))
- ;
- ;
- ;
- NRT11 ; Add New Review Types (#356.11): number ^ CODE (.02) ^ ABBREVIATION (.03) ^ NAME (.01)
- ;;1^25^SNF/NHCU^SNF/NHCU REVIEW
- ;;2^35^RETRO INPT^INPT RETROSPECTIVE REVIEW
- ;;3^55^RETRO OPT^OPT RETROSPECTIVE REVIEW
- ;;
- ;
- NDR21 ; Add New Denial Reasons (#356.21): number ^ ABBREVIATION (.02) ^ NAME (.01)
- ;;1^DELAY TX^DELAY IN TREATMENT/SERVICE
- ;;2^OBS^OBSERVATION IS MORE APPROPRIATE
- ;;3^ALT LOC^ALTERNATE LEVEL OF CARE IS MORE APPROPRIATE
- ;;
- ;
- ERNB8 ; Edit RNB name (#356.8): number ^ OLD NAME (.01) ^ NEW NAME (.01)
- ;;1^NPI/TAXONOMY ISSUES^NPI/TAXONOMY/PPN ISSUES
- ;;
- ;
- NRNB8 ; Add New RNBs (#356.8): number ^ ECME FLAG (0/1) (.02) ^ ECME PAPER FLAG (0/1) (.03) ^ CODE (.04) ^ NAME (.01)
- ;;1^^^MC20^APPT CANCELLED/PT NOT SEEN
- ;;2^^^MC21^SEEN BY PROVIDER ON SAME DAY
- ;;3^^^MC22^NON-BILLABLE DME/PROSTHETIC
- ;;4^^^MC23^NON-BILLABLE PROCEDURE
- ;;5^1^0^MC24^EMPLOYEE HEALTH
- ;;6^^^MC25^ENCOUNTER DURING INPT STAY
- ;;7^^^CV22^NO PROSTHETIC COVERAGE
- ;;8^^^CV23^NON-COVERED DIAGNOSIS
- ;;9^^^CV24^NON-COVERED ROUTINE CARE
- ;;10^1^0^CV25^HDHP PLAN NOT BILLED
- ;;11^^^CV26^NOT RELATED TO WC/TORT/NF
- ;;12^1^0^CV27^TRICARE PT SEEN AS VETERAN
- ;;13^^^BL08^COMBINED CHARGES
- ;;14^^^BL09^UNBUNDLED SERVICE
- ;;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYP458 7652 printed Dec 13, 2024@02:35:55 Page 2
- IBYP458 ;ALB/ARH - IB*2.0*458 POST INIT: RCBE III UPDATE ; 16-OCT-2012
- +1 ;;2.0;INTEGRATED BILLING;**458**;21-MAR-94;Build 4
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 QUIT
- PRE ; RCBE III (VF #2) PRE-INSTALL
- +1 ; clean up, delete APRE1 xref (#1) on Insurance Review Authorization Number field (#356.2,.28)
- +2 ;
- +3 NEW IBA
- SET IBA(2)=" IB*2*458 Pre-Install ....."
- SET IBA(1)=" "
- DO MES^XPDUTL(.IBA)
- KILL IBA
- +4 ;
- +5 DO DELIX^DDMOD(356.2,.28,1)
- +6 SET IBA(2)=" >> ^DD(356.2,.28) cross-reference #1 deleted"
- SET IBA(1)=" "
- +7 SET IBA(3)=" Insurance Review (#356.2) Authorization Number (.28) xref APRE1"
- DO MES^XPDUTL(.IBA)
- KILL IBA
- +8 ;
- +9 SET IBA(2)=" IB*2*458 Pre-Install Complete"
- SET (IBA(1),IBA(3))=" "
- DO MES^XPDUTL(.IBA)
- KILL IBA
- +10 QUIT
- +11 ;
- +12 ;
- POST ; RCBE III (VF #2) POST-INSTALL
- +1 ;
- +2 NEW IBA
- SET IBA(2)=" IB*2*458 Post-Install ....."
- SET IBA(1)=" "
- DO MES^XPDUTL(.IBA)
- KILL IBA
- +3 ;
- +4 ; Add 3 Claims Tracking Review Types, New (#356.11)
- DO CTRT
- +5 ; Add 3 Claims Tracking Denial Reasons, New (#356.21)
- DO CTDR
- +6 ;
- +7 ; Add 14 RNBs, new (#356.8)
- DO RNBN
- +8 ; Edit 1 RNB, change name (#356.8)
- DO RNBE
- +9 ;
- +10 ; Copy Insurance Review (#356.2) Authorization and Call Reference Number Data
- DO MOVE
- +11 ;
- +12 SET IBA(2)=" IB*2*458 Post-Install Complete"
- SET (IBA(1),IBA(3))=" "
- DO MES^XPDUTL(.IBA)
- KILL IBA
- +13 QUIT
- +14 ;
- +15 ;
- CTRT ; Add New Claims Tracking Review Types (#356.11)
- +1 NEW IBI,IBRIEN,IBLN,IBNM,IBCTRT,IBTOT,IBTNC,IBTCH,DIE,DIC,DR,DA,DD,DO,X,Y,DLAYGO,DINUM
- +2 SET (IBTOT,IBTNC,IBTCH)=0
- SET DLAYGO=356.11
- +3 ;
- +4 DO MSG("Add 3 Claims Tracking Review Types, New (#356.11) ...",1)
- +5 ;
- +6 FOR IBI=1:1
- SET IBLN=$PIECE($TEXT(NRT11+IBI),";;",2,999)
- if 'IBLN
- QUIT
- Begin DoDot:1
- +7 ;
- +8 SET IBNM=$PIECE(IBLN,U,4)
- SET IBCTRT=$ORDER(^IBE(356.11,"B",IBNM,0))
- +9 FOR IBRIEN=11:1
- IF '$DATA(^IBE(356.11,IBRIEN,0))
- QUIT
- +10 ;
- +11 SET IBTOT=IBTOT+1
- IF +IBCTRT
- SET IBTNC=IBTNC+1
- QUIT
- +12 ;
- +13 SET DIC="^IBE(356.11,"
- SET DIC("DR")=".02////"_$PIECE(IBLN,U,2)_";.03////"_$PIECE(IBLN,U,3)
- +14 SET DIC(0)="L"
- SET X=IBNM
- SET DINUM=IBRIEN
- DO FILE^DICN
- KILL DIC
- IF 'Y
- DO MSG(IBNM_" Not Added, ERROR ****")
- QUIT
- +15 SET IBTCH=IBTCH+1
- DO MSG(IBNM_" added")
- End DoDot:1
- +16 ;
- +17 IF 'IBTCH
- DO MSG("No Change: "_IBTNC_" of "_IBTOT_" New Review Types Already Exist")
- +18 IF +IBTCH
- DO MSG("Updated: "_IBTCH_" of "_IBTOT_" New Review Types Added"_$$LN(IBTNC,"Already Exist"),2)
- +19 QUIT
- +20 ;
- +21 ;
- CTDR ; Add New Claims Tracking Denial Reasons (#356.21)
- +1 NEW IBI,IBRIEN,IBLN,IBNM,IBCTDR,IBTOT,IBTNC,IBTCH,DIE,DIC,DR,DA,DD,DO,X,Y,DLAYGO,DINUM
- +2 SET (IBTOT,IBTNC,IBTCH)=0
- SET DLAYGO=356.21
- +3 ;
- +4 DO MSG("Add 3 Claims Tracking Denial Reasons, New (#356.21) ...",1)
- +5 ;
- +6 FOR IBI=1:1
- SET IBLN=$PIECE($TEXT(NDR21+IBI),";;",2,999)
- if 'IBLN
- QUIT
- Begin DoDot:1
- +7 ;
- +8 SET IBNM=$PIECE(IBLN,U,3)
- SET IBCTDR=$ORDER(^IBE(356.21,"B",$EXTRACT(IBNM,1,30),0))
- +9 FOR IBRIEN=8:1
- IF '$DATA(^IBE(356.21,IBRIEN,0))
- QUIT
- +10 ;
- +11 SET IBTOT=IBTOT+1
- IF +IBCTDR
- SET IBTNC=IBTNC+1
- QUIT
- +12 ;
- +13 SET DIC="^IBE(356.21,"
- SET DIC("DR")=".02////"_$PIECE(IBLN,U,2)
- +14 SET DIC(0)="L"
- SET X=IBNM
- SET DINUM=IBRIEN
- DO FILE^DICN
- KILL DIC
- IF 'Y
- DO MSG(IBNM_" Not Added, ERROR ****")
- QUIT
- +15 SET IBTCH=IBTCH+1
- DO MSG(IBNM_" added")
- End DoDot:1
- +16 ;
- +17 IF 'IBTCH
- DO MSG("No Change: "_IBTNC_" of "_IBTOT_" New Denial Reasons Already Exist")
- +18 IF +IBTCH
- DO MSG("Updated: "_IBTCH_" of "_IBTOT_" New Denial Reasons Added"_$$LN(IBTNC,"Already Exist"),2)
- +19 QUIT
- +20 ;
- +21 ;
- RNBE ; Edit Reasons Not Billable: Rename one existing RNB (356.8,.01)
- +1 NEW DIE,DIC,DA,DR,X,Y,IBI,IBLN,IBOLD,IBNEW,IBRNB,IBTOT,IBTNC,IBTNF,IBTCH
- SET (IBTOT,IBTNC,IBTNF,IBTCH)=0
- +2 ;
- +3 DO MSG("Change 1 Reasons Not Billable (RNB), Name (#356.8, .01) ...",1)
- +4 ;
- +5 FOR IBI=1:1
- SET IBLN=$PIECE($TEXT(ERNB8+IBI),";;",2,999)
- if 'IBLN
- QUIT
- Begin DoDot:1
- +6 SET IBOLD=$PIECE(IBLN,U,2)
- SET IBNEW=$PIECE(IBLN,U,3)
- SET IBRNB=$ORDER(^IBE(356.8,"B",IBOLD,0))
- +7 ;
- +8 SET IBTOT=IBTOT+1
- +9 IF $ORDER(^IBE(356.8,"B",IBNEW,0))
- SET IBTNC=IBTNC+1
- QUIT
- +10 IF 'IBRNB
- SET IBTNF=IBTNF+1
- DO MSG(IBOLD_" not found, Error")
- QUIT
- +11 ;
- +12 NEW DIE,DIC,X,Y
- SET DA=+IBRNB
- SET DR=".01///"_IBNEW
- SET DIE="^IBE(356.8,"
- DO ^DIE
- KILL DA,DR
- +13 SET IBTCH=IBTCH+1
- DO MSG(IBOLD_" changed to "_IBNEW)
- End DoDot:1
- +14 ;
- +15 IF 'IBTCH
- DO MSG("No Change: "_IBTNC_" of "_IBTOT_" RNB Names Already Changed"_$$LN(IBTNF,"Not Found"))
- +16 IF +IBTCH
- DO MSG("Updated: "_IBTCH_" of "_IBTOT_" RNB Names Updated"_$$LN(IBTNC,"Already Changed")_$$LN(IBTNF,"Not Found"),2)
- +17 QUIT
- +18 ;
- +19 ;
- RNBN ; Add New Reasons Not Billable (#356.8)
- +1 NEW IBI,IBRIEN,IBLN,IBNM,IBRNB,IBTOT,IBTNC,IBTCH,DIE,DIC,DR,DA,DD,DO,X,Y,DLAYGO,DINUM
- +2 SET (IBTOT,IBTNC,IBTCH)=0
- SET DLAYGO=356.8
- +3 ;
- +4 DO MSG("Add 14 Reasons Not Billable (RNB), New (#356.8) ...",1)
- +5 ;
- +6 FOR IBI=1:1
- SET IBLN=$PIECE($TEXT(NRNB8+IBI),";;",2,999)
- if 'IBLN
- QUIT
- Begin DoDot:1
- +7 ;
- +8 SET IBNM=$PIECE(IBLN,U,5)
- SET IBRNB=$ORDER(^IBE(356.8,"B",IBNM,0))
- +9 FOR IBRIEN=100:1
- IF '$DATA(^IBE(356.8,IBRIEN,0))
- QUIT
- +10 ;
- +11 SET IBTOT=IBTOT+1
- IF +IBRNB
- SET IBTNC=IBTNC+1
- QUIT
- +12 ;
- +13 SET DIC="^IBE(356.8,"
- SET DIC("DR")=".02////"_$PIECE(IBLN,U,2)_";.03////"_$PIECE(IBLN,U,3)_";.04///"_$PIECE(IBLN,U,4)
- +14 SET DIC(0)="L"
- SET X=IBNM
- SET DINUM=IBRIEN
- DO FILE^DICN
- KILL DIC
- IF 'Y
- DO MSG(IBNM_" Not Added, ERROR ****")
- QUIT
- +15 SET IBTCH=IBTCH+1
- DO MSG(IBNM_" added")
- End DoDot:1
- +16 ;
- +17 IF 'IBTCH
- DO MSG("No Change: "_IBTNC_" of "_IBTOT_" New RNBs Already Exist")
- +18 IF +IBTCH
- DO MSG("Updated: "_IBTCH_" of "_IBTOT_" New RNBs Added"_$$LN(IBTNC,"Already Exist"),2)
- +19 QUIT
- +20 ;
- +21 ;
- MOVE ; Move Insurance Review (#356.2) Call Reference and Authorization Number Data
- +1 ; from old fields/location (.09, .28) to new fields/location (2.01, 2.02)
- +2 NEW IBTRC,IBTRC0,IBTRC2,IBCOLD,IBAOLD,IBCC1,IBCC2,IBAC1,IBAC2,DIE,DIC,DA,DR,X,Y
- +3 SET (IBCC1,IBCC2,IBAC1,IBAC2)=0
- +4 ;
- +5 DO MSG("Copy Insurance Review (#356.2) Data to New Field Locations ...",1)
- +6 DO MSG("Searching file for data to copy, "_+$PIECE($GET(^IBT(356.2,0)),U,4)_" entries, please wait ...")
- +7 ;
- +8 SET IBTRC=0
- FOR
- SET IBTRC=$ORDER(^IBT(356.2,IBTRC))
- if 'IBTRC
- QUIT
- Begin DoDot:1
- +9 SET IBTRC0=$GET(^IBT(356.2,IBTRC,0))
- SET IBCOLD=$PIECE(IBTRC0,U,9)
- SET IBAOLD=$PIECE(IBTRC0,U,28)
- +10 SET IBTRC2=$GET(^IBT(356.2,IBTRC,2))
- SET DR=""
- +11 ;
- +12 IF IBCOLD'=""
- SET IBCC1=IBCC1+1
- IF $PIECE(IBTRC2,U,1)=""
- SET DR=DR_"2.01////^S X=IBCOLD;"
- SET IBCC2=IBCC2+1
- +13 IF IBAOLD'=""
- SET IBAC1=IBAC1+1
- IF $PIECE(IBTRC2,U,2)=""
- SET DR=DR_"2.02////^S X=IBAOLD"
- SET IBAC2=IBAC2+1
- +14 ;
- +15 IF DR'=""
- SET DIE="^IBT(356.2,"
- SET DA=IBTRC
- DO ^DIE
- KILL DIE,DIC,DA,DR
- End DoDot:1
- +16 ;
- +17 DO MSG(IBCC1_" Call Reference Numbers found (.09), "_IBCC2_" copied (2.01)",2)
- +18 DO MSG(IBAC1_" Authorization Numbers found (.28), "_IBAC2_" copied (2.02)")
- +19 QUIT
- +20 ;
- +21 ;
- +22 ;
- MSG(X,Y) ; set lines into patch install message, X is message, Y is line type (1-header, 2-result line)
- +1 NEW CNT,IBA
- SET CNT=1
- SET IBA(1)=" "
- IF +$GET(Y)
- SET CNT=2
- SET IBA(2)=IBA(1)
- IF +$GET(Y)=1
- SET IBA(2)=" >> "
- +2 SET IBA(CNT)=IBA(CNT)_$GET(X)
- DO MES^XPDUTL(.IBA)
- KILL IBA
- +3 QUIT
- +4 ;
- LN(NUM,TXT) QUIT $SELECT('$GET(NUM):"",1:", "_$GET(NUM)_" "_$GET(TXT))
- +1 ;
- +2 ;
- +3 ;
- NRT11 ; Add New Review Types (#356.11): number ^ CODE (.02) ^ ABBREVIATION (.03) ^ NAME (.01)
- +1 ;;1^25^SNF/NHCU^SNF/NHCU REVIEW
- +2 ;;2^35^RETRO INPT^INPT RETROSPECTIVE REVIEW
- +3 ;;3^55^RETRO OPT^OPT RETROSPECTIVE REVIEW
- +4 ;;
- +5 ;
- NDR21 ; Add New Denial Reasons (#356.21): number ^ ABBREVIATION (.02) ^ NAME (.01)
- +1 ;;1^DELAY TX^DELAY IN TREATMENT/SERVICE
- +2 ;;2^OBS^OBSERVATION IS MORE APPROPRIATE
- +3 ;;3^ALT LOC^ALTERNATE LEVEL OF CARE IS MORE APPROPRIATE
- +4 ;;
- +5 ;
- ERNB8 ; Edit RNB name (#356.8): number ^ OLD NAME (.01) ^ NEW NAME (.01)
- +1 ;;1^NPI/TAXONOMY ISSUES^NPI/TAXONOMY/PPN ISSUES
- +2 ;;
- +3 ;
- NRNB8 ; Add New RNBs (#356.8): number ^ ECME FLAG (0/1) (.02) ^ ECME PAPER FLAG (0/1) (.03) ^ CODE (.04) ^ NAME (.01)
- +1 ;;1^^^MC20^APPT CANCELLED/PT NOT SEEN
- +2 ;;2^^^MC21^SEEN BY PROVIDER ON SAME DAY
- +3 ;;3^^^MC22^NON-BILLABLE DME/PROSTHETIC
- +4 ;;4^^^MC23^NON-BILLABLE PROCEDURE
- +5 ;;5^1^0^MC24^EMPLOYEE HEALTH
- +6 ;;6^^^MC25^ENCOUNTER DURING INPT STAY
- +7 ;;7^^^CV22^NO PROSTHETIC COVERAGE
- +8 ;;8^^^CV23^NON-COVERED DIAGNOSIS
- +9 ;;9^^^CV24^NON-COVERED ROUTINE CARE
- +10 ;;10^1^0^CV25^HDHP PLAN NOT BILLED
- +11 ;;11^^^CV26^NOT RELATED TO WC/TORT/NF
- +12 ;;12^1^0^CV27^TRICARE PT SEEN AS VETERAN
- +13 ;;13^^^BL08^COMBINED CHARGES
- +14 ;;14^^^BL09^UNBUNDLED SERVICE
- +15 ;;