- IBTRVD1 ;ALB/AAS - CLAIMS TRACKING REVIEW EDIT ; 06-JUL-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- % G ^IBTRV
- ;
- QE ; -- Review Criteria edit
- N IBXX,VALMY,DA,DR,DIC,DIE
- D QE1^IBTRV1
- D BLD^IBTRVD
- S VALMBCK="R"
- Q
- ;
- NX(IBTMPNM,BLD) ; -- edit next template
- N IBXX,VALMY,IBTRC
- D EN^VALM(IBTMPNM)
- I '$D(IBFASTXT),'$G(BLD) D BLD^IBTRVD
- S VALMBCK="R"
- Q
- ;
- EDIT(DR,BLD) ; -- edit entry point for claims tracking reviews
- ; -- Input IBTEMP = template name or dr string
- ; BLD = any non-zero value if calling routine is doing own
- ; rebuild
- ;
- N IBDIF,DA,DIC,DIE,DIR,X,Y
- D FULL^VALM1 W !
- L +^IBT(356.1,+IBTRV):5 I '$T D LOCKED^IBTRCD1 G EDITQ
- D SAVE
- S DIE="^IBT(356.1,",DA=IBTRV
- D ^DIE K DA,DR,DIC,DIE
- D COMP
- I '$D(IBCON) D CON K IBCON
- I IBDIF=1 D UPDATE,BLD^IBTRVD:'$G(BLD)
- L -^IBT(356.1,+IBTRN)
- EDITQ K ^TMP($J,"IBT")
- S VALMBCK="R"
- Q
- ;
- SAVE ; -- Save the global before editing
- K ^TMP($J,"IBT")
- S ^TMP($J,"IBT",356.1,IBTRV,0)=$G(^IBT(356.1,IBTRV,0))
- S ^TMP($J,"IBT",356.1,IBTRV,1)=$G(^IBT(356.1,IBTRV,1))
- S ^TMP($J,"IBT",356.1,IBTRV,11,0)=$G(^IBT(356.1,IBTRV,11,0))
- Q
- ;
- COMP ; -- Compare before editing with globals
- S IBDIF=0
- I $G(^IBT(356.1,IBTRV,0))'=$G(^TMP($J,"IBT",356.1,IBTRV,0)) S IBDIF=1 Q
- I $G(^IBT(356.1,IBTRV,1))'=$G(^TMP($J,"IBT",356.1,IBTRV,1)) S IBDIF=1 Q
- I $G(^IBT(356.1,IBTRV,11,0))'=$G(^TMP($J,"IBT",356.1,IBTRV,11,0)) S IBDIF=1 Q
- Q
- ;
- UPDATE ; -- enter date and user if editing has taken place
- ; entry locked by edit, locks not needed here
- S DIE="^IBT(356.1,",DA=IBTRV
- S DR="1.03///NOW;1.04////"_DUZ
- D ^DIE K DA,DR,DIC,DIE
- Q
- ;
- CON ; -- consistency checker for hospital reviews
- N I,J,X,Y,DA,DR,DIC,DIE,IBI,IBTRTP,IBDEL
- S IBCON=1
- S IBTRTP=$P($G(^IBE(356.11,+$P($G(^IBT(356.1,IBTRV,0)),"^",22),0)),"^",2)
- ; -- if admission review
- I IBTRTP=15 D
- .S X=$G(^IBT(356.1,IBTRV,0))
- .I '$P(X,"^",4),'$P(X,"^",5),'$P(X,"^",6),'$O(^IBT(356.1,IBTRV,12,0)) W !!,*7,"Warning: Admission Criteria does NOT appear to be met but Reason for",!,"Non Acute Admission Missing." D EDIT("12",1)
- .I $P(X,"^",4)!($P(X,"^",5))!($P(X,"^",6)) I $O(^IBT(356.1,IBTRV,12,0)) W !!,*7,"Warning: Admission Criteria appears to be met but has Reason for ",!,"Non Acute Admission." D EDIT("12",1)
- .Q
- ; -- if cont. stay review
- I IBTRTP=30 D
- .S X=$G(^IBT(356.1,IBTRV,0))
- .I '$P(X,"^",4),'$P(X,"^",5),$P(X,"^",12),'$O(^IBT(356.1,IBTRV,13,0)) W !!,*7,"Warning: Acute Care Criteria does NOT appear to be met but Reason for",!,"Non Acute Days Missing." D EDIT(13,1)
- .I $P(X,"^",4)!($P(X,"^",5)) I $O(^IBT(356.1,IBTRV,13,0)) W !!,*7,"Warning: Acute Care Criteria appears to be met but has Reason for ",!,"Non Acute Days." D EDIT(13,1)
- .Q
- ; -- check Next Review Dates
- S IBI=0 F S IBI=$O(^IBT(356.1,"C",IBTRN,IBI)) Q:'IBI I IBI'=IBTRV D
- .I $P($G(^IBT(356.1,IBI,0)),"^",20) S IBI(IBI)=""
- .Q
- I $O(IBI(0)) D ASKDEL I IBDEL D
- .I $P(^IBT(356.1,IBTRV,0),U,20) D
- ..W !," There are other reviews for this admission with a next review date"
- ..W !," specified. Generally, only the last review for an admission should"
- ..W !," have a next review date. Please check the reviews for this case and"
- ..W !," delete all unnecessary 'next review dates'."
- ..H 3 Q
- .I $O(IBI(+$O(IBI(0)))) D
- .;S IBI=0 F S IBI=$O(IBI(IBI)) Q:'IBI S DA=IBI,DR=".2///@",DIE="^IBT(356.1," D ^DIE
- .;W !,"Next Review Dates have all been deleted, except for this review"
- .Q
- Q
- ;
- ASKDEL ; -- ask if okay to delete next review dates
- S IBDEL=1
- Q
- ;
- IA(IBTRV,BLD) ; -- Insurance action
- ; -- add/edit communications in bkgrnd for a review
- ; quick edit a communications entry.
- ;
- I '$G(BLD) D BLD^IBTRVD
- S VALMBCK="R"
- Q
- IBTRVD1 ;ALB/AAS - CLAIMS TRACKING REVIEW EDIT ; 06-JUL-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- % GOTO ^IBTRV
- +1 ;
- QE ; -- Review Criteria edit
- +1 NEW IBXX,VALMY,DA,DR,DIC,DIE
- +2 DO QE1^IBTRV1
- +3 DO BLD^IBTRVD
- +4 SET VALMBCK="R"
- +5 QUIT
- +6 ;
- NX(IBTMPNM,BLD) ; -- edit next template
- +1 NEW IBXX,VALMY,IBTRC
- +2 DO EN^VALM(IBTMPNM)
- +3 IF '$DATA(IBFASTXT)
- IF '$GET(BLD)
- DO BLD^IBTRVD
- +4 SET VALMBCK="R"
- +5 QUIT
- +6 ;
- EDIT(DR,BLD) ; -- edit entry point for claims tracking reviews
- +1 ; -- Input IBTEMP = template name or dr string
- +2 ; BLD = any non-zero value if calling routine is doing own
- +3 ; rebuild
- +4 ;
- +5 NEW IBDIF,DA,DIC,DIE,DIR,X,Y
- +6 DO FULL^VALM1
- WRITE !
- +7 LOCK +^IBT(356.1,+IBTRV):5
- IF '$TEST
- DO LOCKED^IBTRCD1
- GOTO EDITQ
- +8 DO SAVE
- +9 SET DIE="^IBT(356.1,"
- SET DA=IBTRV
- +10 DO ^DIE
- KILL DA,DR,DIC,DIE
- +11 DO COMP
- +12 IF '$DATA(IBCON)
- DO CON
- KILL IBCON
- +13 IF IBDIF=1
- DO UPDATE
- IF '$GET(BLD)
- DO BLD^IBTRVD
- +14 LOCK -^IBT(356.1,+IBTRN)
- EDITQ KILL ^TMP($JOB,"IBT")
- +1 SET VALMBCK="R"
- +2 QUIT
- +3 ;
- SAVE ; -- Save the global before editing
- +1 KILL ^TMP($JOB,"IBT")
- +2 SET ^TMP($JOB,"IBT",356.1,IBTRV,0)=$GET(^IBT(356.1,IBTRV,0))
- +3 SET ^TMP($JOB,"IBT",356.1,IBTRV,1)=$GET(^IBT(356.1,IBTRV,1))
- +4 SET ^TMP($JOB,"IBT",356.1,IBTRV,11,0)=$GET(^IBT(356.1,IBTRV,11,0))
- +5 QUIT
- +6 ;
- COMP ; -- Compare before editing with globals
- +1 SET IBDIF=0
- +2 IF $GET(^IBT(356.1,IBTRV,0))'=$GET(^TMP($JOB,"IBT",356.1,IBTRV,0))
- SET IBDIF=1
- QUIT
- +3 IF $GET(^IBT(356.1,IBTRV,1))'=$GET(^TMP($JOB,"IBT",356.1,IBTRV,1))
- SET IBDIF=1
- QUIT
- +4 IF $GET(^IBT(356.1,IBTRV,11,0))'=$GET(^TMP($JOB,"IBT",356.1,IBTRV,11,0))
- SET IBDIF=1
- QUIT
- +5 QUIT
- +6 ;
- UPDATE ; -- enter date and user if editing has taken place
- +1 ; entry locked by edit, locks not needed here
- +2 SET DIE="^IBT(356.1,"
- SET DA=IBTRV
- +3 SET DR="1.03///NOW;1.04////"_DUZ
- +4 DO ^DIE
- KILL DA,DR,DIC,DIE
- +5 QUIT
- +6 ;
- CON ; -- consistency checker for hospital reviews
- +1 NEW I,J,X,Y,DA,DR,DIC,DIE,IBI,IBTRTP,IBDEL
- +2 SET IBCON=1
- +3 SET IBTRTP=$PIECE($GET(^IBE(356.11,+$PIECE($GET(^IBT(356.1,IBTRV,0)),"^",22),0)),"^",2)
- +4 ; -- if admission review
- +5 IF IBTRTP=15
- Begin DoDot:1
- +6 SET X=$GET(^IBT(356.1,IBTRV,0))
- +7 IF '$PIECE(X,"^",4)
- IF '$PIECE(X,"^",5)
- IF '$PIECE(X,"^",6)
- IF '$ORDER(^IBT(356.1,IBTRV,12,0))
- WRITE !!,*7,"Warning: Admission Criteria does NOT appear to be met but Reason for",!,"Non Acute Admission Missing."
- DO EDIT("12",1)
- +8 IF $PIECE(X,"^",4)!($PIECE(X,"^",5))!($PIECE(X,"^",6))
- IF $ORDER(^IBT(356.1,IBTRV,12,0))
- WRITE !!,*7,"Warning: Admission Criteria appears to be met but has Reason for ",!,"Non Acute Admission."
- DO EDIT("12",1)
- +9 QUIT
- End DoDot:1
- +10 ; -- if cont. stay review
- +11 IF IBTRTP=30
- Begin DoDot:1
- +12 SET X=$GET(^IBT(356.1,IBTRV,0))
- +13 IF '$PIECE(X,"^",4)
- IF '$PIECE(X,"^",5)
- IF $PIECE(X,"^",12)
- IF '$ORDER(^IBT(356.1,IBTRV,13,0))
- WRITE !!,*7,"Warning: Acute Care Criteria does NOT appear to be met but Reason for",!,"Non Acute Days Missing."
- DO EDIT(13,1)
- +14 IF $PIECE(X,"^",4)!($PIECE(X,"^",5))
- IF $ORDER(^IBT(356.1,IBTRV,13,0))
- WRITE !!,*7,"Warning: Acute Care Criteria appears to be met but has Reason for ",!,"Non Acute Days."
- DO EDIT(13,1)
- +15 QUIT
- End DoDot:1
- +16 ; -- check Next Review Dates
- +17 SET IBI=0
- FOR
- SET IBI=$ORDER(^IBT(356.1,"C",IBTRN,IBI))
- IF 'IBI
- QUIT
- IF IBI'=IBTRV
- Begin DoDot:1
- +18 IF $PIECE($GET(^IBT(356.1,IBI,0)),"^",20)
- SET IBI(IBI)=""
- +19 QUIT
- End DoDot:1
- +20 IF $ORDER(IBI(0))
- DO ASKDEL
- IF IBDEL
- Begin DoDot:1
- +21 IF $PIECE(^IBT(356.1,IBTRV,0),U,20)
- Begin DoDot:2
- +22 WRITE !," There are other reviews for this admission with a next review date"
- +23 WRITE !," specified. Generally, only the last review for an admission should"
- +24 WRITE !," have a next review date. Please check the reviews for this case and"
- +25 WRITE !," delete all unnecessary 'next review dates'."
- +26 HANG 3
- QUIT
- End DoDot:2
- +27 IF $ORDER(IBI(+$ORDER(IBI(0))))
- Begin DoDot:2
- End DoDot:2
- +28 ;S IBI=0 F S IBI=$O(IBI(IBI)) Q:'IBI S DA=IBI,DR=".2///@",DIE="^IBT(356.1," D ^DIE
- +29 ;W !,"Next Review Dates have all been deleted, except for this review"
- +30 QUIT
- End DoDot:1
- +31 QUIT
- +32 ;
- ASKDEL ; -- ask if okay to delete next review dates
- +1 SET IBDEL=1
- +2 QUIT
- +3 ;
- IA(IBTRV,BLD) ; -- Insurance action
- +1 ; -- add/edit communications in bkgrnd for a review
- +2 ; quick edit a communications entry.
- +3 ;
- +4 IF '$GET(BLD)
- DO BLD^IBTRVD
- +5 SET VALMBCK="R"
- +6 QUIT
