IBCRHL ;ALB/ARH - RATES: UPLOAD CHECK & ADD TO CM SEARCH ; 22-MAY-1996
;;2.0;INTEGRATED BILLING;**52,106,138,245,634**;21-MAR-94;Build 57
;;Per VA Directive 6402, this routine should not be modified.
;
; check data in XTMP files to see if it can be loaded into the Charge Master
; file checks: Charge Set and Billable Items defined and match
; line checks: these must be true for the item to be added to CM (Errors)
; - item in source file and is active
; - NDCs not checked since these are added to the source file (363.21) if not defined
; - if CPT and Modifier defined then modifier must be valid for the CPT
; - dates are in correct format
; - inactive date and modifier are not required
;
; duplicates: the new charge for an Item is compared to any existing charges for the Item in the CM,
; duplicates are not added
; - possible duplicates: CS, item, eff dt, and modifier all match
; - these are NOT counted as Duplicates, but as Errors so they can be displayed
; individually on the reports
; - exact duplicates: CS, item, eff dt, modifier, and Charge all match
; - these will be counted as exact Duplicates and are not added to CM
; - removed IB*2*138: no change in charge: the same charge already exists for the item
; - this is basically an exact duplicate except the effective date may be different
; - these will be counted as exact Duplicates and are not added to CM
;
; zero charge: Items uploaded with a with zero charge are not added to CM
; - on check report all items found with a zero charge are added to the Zero Count
; - if an active charge currently exists in CM for the item of the zero charge then
; - the existing charge is inactivated by having an inactive date added
; - the inactive date added is 1 day before the zero charges effective date
; - the effective dates do not have to match, the charge just has to be active
; on the zero charge effective date
; - on the Add report these added to the Inactive Count
;
; Inactive Date: Tries to inactivate an existing entry if the Item uploaded is inactive
; - if a charge has an inactive date but is an exact duplicate of an existing charge
; - the existing charge must match effective date and not already have an inactive date
; - the inactive date will be added as the Inactive Date of the existing charge
; - these will be counted as Duplicates during the Check but as Inactives during the Add
;
; NDC Numbers not already defined in 363.31 are automatically added
;
SRCH(FILE,ADD) ; search and check a particular Host file
; results: ^TMP($J,FILE,SUBFILE) = ^ comment 1 ^ comment 2 ^ comment 3
; ^TMP($J,FILE,SUBFILE,X) = error # ^ comment/error
;
N IBSUB,IBTSCNT,IBCS,IBCI,IBBI,IBADD,IBDUP,IBCNT,IBZERO,IBERR,IBINAC,IBLN,IBX,IBY,IBZ,IBITM,IBARR Q:$G(FILE)=""
K ^TMP($J,FILE) I $G(^XTMP(FILE,0))="" Q
I '$D(ZTQUEUED) W !!,$S(+$G(ADD):"Loading data into Charge Master:",1:"Data validity check on temporary files:")
;
S IBSUB=0 F S IBSUB=$O(^XTMP(FILE,IBSUB)) Q:IBSUB="" D CHECKS
;
Q
;
;
CHECKS ;
S IBTSCNT=+$G(^XTMP(FILE,IBSUB))
S IBCS=+$P($G(^XTMP(FILE,IBSUB)),U,3) I '+IBCS Q
S IBBI=$$CSBI^IBCRU3(+IBCS)
I '$D(ZTQUEUED) W !!,FILE,?35,IBSUB,?50
;
S IBY=$$CHKFL^IBCRHU1(IBCS,FILE,IBSUB) I +IBY D SETF(IBY) Q
;
S (IBDUP,IBERR,IBADD,IBINAC,IBZERO,IBCNT,IBX)=0
;
F S IBX=$O(^XTMP(FILE,IBSUB,IBX)) Q:'IBX D Q:+IBY=3
. I '$D(ZTQUEUED),'(IBCNT#100) W "."
. S IBY=0,IBCNT=IBCNT+1,IBLN=$G(^XTMP(FILE,IBSUB,IBX)) Q:IBLN=""
. S IBITM=$$ITPTR^IBCRU2(IBBI,$P(IBLN,U,1))
. ;
. I +$G(ADD),'IBITM,+IBBI=3 S IBITM=$$ADDBI^IBCREF("NDC",$P(IBLN,U,1)) Q:'IBITM
. ;
. I '$P(IBLN,U,4) D S:'IBCI IBZERO=IBZERO+1 Q
.. S IBCI=0 K IBARR I '$G(ADD)!+IBY Q
.. D ITMCHG^IBCRCC(IBCS,IBITM,$P(IBLN,U,2),$P(IBLN,U,5),.IBARR) S IBCI=+$G(IBARR(1))
.. I +IBCI S IBZ=$$FMADD^XLFDT($P(IBLN,U,2),-1) D EDITCI^IBCREF(+IBCI,"","","",IBZ) S IBINAC=IBINAC+1
. ;
. I +$G(ADD),+$P(IBLN,U,3) D I +IBCI Q
.. S IBCI=$$FINDCI^IBCRU4(IBCS,IBITM,$P(IBLN,U,2),$P(IBLN,U,5),"",$P(IBLN,U,4),"",,$P(IBLN,U,6))
.. I +IBCI D EDITCI^IBCREF(IBCI,"","","",$P(IBLN,U,3)) S IBINAC=IBINAC+1
. ;
. S IBY=$$CHKLN^IBCRHU1(IBBI,IBLN) I +IBY D SETL(IBY) S IBERR=IBERR+1 Q
. ;
. S IBY=$$CHKDUP^IBCRHU1(IBCS,IBLN,+$G(ADD)) I +IBY S:+IBY=2 IBDUP=IBDUP+1 D:+IBY'=2 SETL(IBY) S:+IBY<2 IBERR=IBERR+1 Q
. ;
. I +$G(ADD),'IBY D
.. I $$ADDCI^IBCREF(IBCS,IBITM,$P(IBLN,U,2),+$P(IBLN,U,4),$S($$RVCD(IBSUB,IBITM):124,1:""),$P(IBLN,U,5),$P(IBLN,U,3),$P(IBLN,U,6)) S IBADD=IBADD+1
;
I +IBCNT,$G(^TMP($J,FILE,IBSUB))="" D D SETF(IBY)
. S IBZ=((IBERR/IBCNT)*100)
. S IBY="0^"_IBCNT_" of "_IBTSCNT_" records checked, "_IBDUP_" duplicates, "_IBZERO_" with $=0^"_IBERR_" line/data errors or warnings found for a "_+$FN(IBZ,"",2)_"% error rate.^"
. ;
. I +$G(ADD),+IBINAC S IBY=IBY_IBINAC_" charges items inactivated, "
. I +$G(ADD) S IBY=IBY_IBADD_" entries added to the Charge Set "_$P($G(^IBE(363.1,+IBCS,0)),U,1)_"."
Q
;
RVCD(IBSUB,IBITM) ; *634 - assign Revenue Code #124 to 5 ms-drg charges
; Input: subfile, charge item
; Output: 0 or 1
N IBMHDG S IBMHDG=0
I IBSUB="Inpt PD R&B",$F("^881^882^883^885^886^",(U_IBITM_U)) S IBMHDG=1
Q IBMHDG
;
SETF(ERROR) ;
S ^TMP($J,FILE,IBSUB)=ERROR
Q
SETL(ERROR) ;
S ^TMP($J,FILE,IBSUB,IBX)=ERROR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRHL 5790 printed Dec 13, 2024@02:19:34 Page 2
IBCRHL ;ALB/ARH - RATES: UPLOAD CHECK & ADD TO CM SEARCH ; 22-MAY-1996
+1 ;;2.0;INTEGRATED BILLING;**52,106,138,245,634**;21-MAR-94;Build 57
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; check data in XTMP files to see if it can be loaded into the Charge Master
+5 ; file checks: Charge Set and Billable Items defined and match
+6 ; line checks: these must be true for the item to be added to CM (Errors)
+7 ; - item in source file and is active
+8 ; - NDCs not checked since these are added to the source file (363.21) if not defined
+9 ; - if CPT and Modifier defined then modifier must be valid for the CPT
+10 ; - dates are in correct format
+11 ; - inactive date and modifier are not required
+12 ;
+13 ; duplicates: the new charge for an Item is compared to any existing charges for the Item in the CM,
+14 ; duplicates are not added
+15 ; - possible duplicates: CS, item, eff dt, and modifier all match
+16 ; - these are NOT counted as Duplicates, but as Errors so they can be displayed
+17 ; individually on the reports
+18 ; - exact duplicates: CS, item, eff dt, modifier, and Charge all match
+19 ; - these will be counted as exact Duplicates and are not added to CM
+20 ; - removed IB*2*138: no change in charge: the same charge already exists for the item
+21 ; - this is basically an exact duplicate except the effective date may be different
+22 ; - these will be counted as exact Duplicates and are not added to CM
+23 ;
+24 ; zero charge: Items uploaded with a with zero charge are not added to CM
+25 ; - on check report all items found with a zero charge are added to the Zero Count
+26 ; - if an active charge currently exists in CM for the item of the zero charge then
+27 ; - the existing charge is inactivated by having an inactive date added
+28 ; - the inactive date added is 1 day before the zero charges effective date
+29 ; - the effective dates do not have to match, the charge just has to be active
+30 ; on the zero charge effective date
+31 ; - on the Add report these added to the Inactive Count
+32 ;
+33 ; Inactive Date: Tries to inactivate an existing entry if the Item uploaded is inactive
+34 ; - if a charge has an inactive date but is an exact duplicate of an existing charge
+35 ; - the existing charge must match effective date and not already have an inactive date
+36 ; - the inactive date will be added as the Inactive Date of the existing charge
+37 ; - these will be counted as Duplicates during the Check but as Inactives during the Add
+38 ;
+39 ; NDC Numbers not already defined in 363.31 are automatically added
+40 ;
SRCH(FILE,ADD) ; search and check a particular Host file
+1 ; results: ^TMP($J,FILE,SUBFILE) = ^ comment 1 ^ comment 2 ^ comment 3
+2 ; ^TMP($J,FILE,SUBFILE,X) = error # ^ comment/error
+3 ;
+4 NEW IBSUB,IBTSCNT,IBCS,IBCI,IBBI,IBADD,IBDUP,IBCNT,IBZERO,IBERR,IBINAC,IBLN,IBX,IBY,IBZ,IBITM,IBARR
if $GET(FILE)=""
QUIT
+5 KILL ^TMP($JOB,FILE)
IF $GET(^XTMP(FILE,0))=""
QUIT
+6 IF '$DATA(ZTQUEUED)
WRITE !!,$SELECT(+$GET(ADD):"Loading data into Charge Master:",1:"Data validity check on temporary files:")
+7 ;
+8 SET IBSUB=0
FOR
SET IBSUB=$ORDER(^XTMP(FILE,IBSUB))
if IBSUB=""
QUIT
DO CHECKS
+9 ;
+10 QUIT
+11 ;
+12 ;
CHECKS ;
+1 SET IBTSCNT=+$GET(^XTMP(FILE,IBSUB))
+2 SET IBCS=+$PIECE($GET(^XTMP(FILE,IBSUB)),U,3)
IF '+IBCS
QUIT
+3 SET IBBI=$$CSBI^IBCRU3(+IBCS)
+4 IF '$DATA(ZTQUEUED)
WRITE !!,FILE,?35,IBSUB,?50
+5 ;
+6 SET IBY=$$CHKFL^IBCRHU1(IBCS,FILE,IBSUB)
IF +IBY
DO SETF(IBY)
QUIT
+7 ;
+8 SET (IBDUP,IBERR,IBADD,IBINAC,IBZERO,IBCNT,IBX)=0
+9 ;
+10 FOR
SET IBX=$ORDER(^XTMP(FILE,IBSUB,IBX))
if 'IBX
QUIT
Begin DoDot:1
+11 IF '$DATA(ZTQUEUED)
IF '(IBCNT#100)
WRITE "."
+12 SET IBY=0
SET IBCNT=IBCNT+1
SET IBLN=$GET(^XTMP(FILE,IBSUB,IBX))
if IBLN=""
QUIT
+13 SET IBITM=$$ITPTR^IBCRU2(IBBI,$PIECE(IBLN,U,1))
+14 ;
+15 IF +$GET(ADD)
IF 'IBITM
IF +IBBI=3
SET IBITM=$$ADDBI^IBCREF("NDC",$PIECE(IBLN,U,1))
if 'IBITM
QUIT
+16 ;
+17 IF '$PIECE(IBLN,U,4)
Begin DoDot:2
+18 SET IBCI=0
KILL IBARR
IF '$GET(ADD)!+IBY
QUIT
+19 DO ITMCHG^IBCRCC(IBCS,IBITM,$PIECE(IBLN,U,2),$PIECE(IBLN,U,5),.IBARR)
SET IBCI=+$GET(IBARR(1))
+20 IF +IBCI
SET IBZ=$$FMADD^XLFDT($PIECE(IBLN,U,2),-1)
DO EDITCI^IBCREF(+IBCI,"","","",IBZ)
SET IBINAC=IBINAC+1
End DoDot:2
if 'IBCI
SET IBZERO=IBZERO+1
QUIT
+21 ;
+22 IF +$GET(ADD)
IF +$PIECE(IBLN,U,3)
Begin DoDot:2
+23 SET IBCI=$$FINDCI^IBCRU4(IBCS,IBITM,$PIECE(IBLN,U,2),$PIECE(IBLN,U,5),"",$PIECE(IBLN,U,4),"",,$PIECE(IBLN,U,6))
+24 IF +IBCI
DO EDITCI^IBCREF(IBCI,"","","",$PIECE(IBLN,U,3))
SET IBINAC=IBINAC+1
End DoDot:2
IF +IBCI
QUIT
+25 ;
+26 SET IBY=$$CHKLN^IBCRHU1(IBBI,IBLN)
IF +IBY
DO SETL(IBY)
SET IBERR=IBERR+1
QUIT
+27 ;
+28 SET IBY=$$CHKDUP^IBCRHU1(IBCS,IBLN,+$GET(ADD))
IF +IBY
if +IBY=2
SET IBDUP=IBDUP+1
if +IBY'=2
DO SETL(IBY)
if +IBY<2
SET IBERR=IBERR+1
QUIT
+29 ;
+30 IF +$GET(ADD)
IF 'IBY
Begin DoDot:2
+31 IF $$ADDCI^IBCREF(IBCS,IBITM,$PIECE(IBLN,U,2),+$PIECE(IBLN,U,4),$SELECT($$RVCD(IBSUB,IBITM):124,1:""),$PIECE(IBLN,U,5),$PIECE(IBLN,U,3),$PIECE(IBLN,U,6))
SET IBADD=IBADD+1
End DoDot:2
End DoDot:1
if +IBY=3
QUIT
+32 ;
+33 IF +IBCNT
IF $GET(^TMP($JOB,FILE,IBSUB))=""
Begin DoDot:1
+34 SET IBZ=((IBERR/IBCNT)*100)
+35 SET IBY="0^"_IBCNT_" of "_IBTSCNT_" records checked, "_IBDUP_" duplicates, "_IBZERO_" with $=0^"_IBERR_" line/data errors or warnings found for a "_+$FNUMBER(IBZ,"",2)_"% error rate.^"
+36 ;
+37 IF +$GET(ADD)
IF +IBINAC
SET IBY=IBY_IBINAC_" charges items inactivated, "
+38 IF +$GET(ADD)
SET IBY=IBY_IBADD_" entries added to the Charge Set "_$PIECE($GET(^IBE(363.1,+IBCS,0)),U,1)_"."
End DoDot:1
DO SETF(IBY)
+39 QUIT
+40 ;
RVCD(IBSUB,IBITM) ; *634 - assign Revenue Code #124 to 5 ms-drg charges
+1 ; Input: subfile, charge item
+2 ; Output: 0 or 1
+3 NEW IBMHDG
SET IBMHDG=0
+4 IF IBSUB="Inpt PD R&B"
IF $FIND("^881^882^883^885^886^",(U_IBITM_U))
SET IBMHDG=1
+5 QUIT IBMHDG
+6 ;
SETF(ERROR) ;
+1 SET ^TMP($JOB,FILE,IBSUB)=ERROR
+2 QUIT
SETL(ERROR) ;
+1 SET ^TMP($JOB,FILE,IBSUB,IBX)=ERROR
+2 QUIT
