Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBTRCD1

IBTRCD1.m

Go to the documentation of this file. 
  1. IBTRCD1	;ALB/AAS - CLAIMS TRACKING INS ACTION EDIT ; 06-JUL-93
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. 	;
  1. %	G ^IBTRC
  1. 	;
  1. QE	; -- Quick edit
  1. 	N IBXX,VALMY,DA,DR,DIC,DIE
  1. 	D QE1^IBTRC1
  1. 	D BLD^IBTRCD
  1. 	S VALMBCK="R"
  1. 	Q
  1. 	;
  1. NX(IBTMPNM,BLD)	; -- edit next template
  1. 	N IBXX,VALMY
  1. 	D EN^VALM(IBTMPNM)
  1. 	I '$D(IBFASTXT) D:'$G(BLD) BLD^IBTRCD
  1. 	S VALMBCK="R"
  1. 	Q
  1. 	;
  1. EDIT(DR,BLD)	; -- edit entry point for claims tracking reviews
  1. 	; -- Input   IBTEMP = template name or dr string
  1. 	;               BLD = any non-zero value if calling routine is doing own
  1. 	;                      rebuild
  1. 	;
  1. 	N IBDIF,DA,DIC,DIE,DIR,X,Y,IBTLST
  1. 	D FULL^VALM1 W !
  1. 	D SAVE
  1. 	S DIE="^IBT(356.2,",DA=IBTRC
  1. 	L +^IBT(356.2,+IBTRC):5 I '$T D LOCKED G EDITQ
  1. 	D ^DIE K DA,DR,DIC,DIE
  1. 	I '$D(IBCON) D CON K IBCON
  1. 	D COMP
  1. 	I IBDIF=1 D UPDATE
  1. 	L -^IBT(356.2,+IBTRC)
  1. 	D BLD^IBTRCD:'$G(BLD)
  1. EDITQ	K ^TMP($J,"IBT")
  1. 	S VALMBCK="R"
  1. 	Q
  1. 	;
  1. SAVE	; -- Save the global before editing
  1. 	K ^TMP($J,"IBT")
  1. 	S ^TMP($J,"IBT",356.2,IBTRC,0)=$G(^IBT(356.2,IBTRC,0))
  1. 	S ^TMP($J,"IBT",356.2,IBTRC,1)=$G(^IBT(356.2,IBTRC,1))
  1. 	S ^TMP($J,"IBT",356.2,IBTRC,11,0)=$G(^IBT(356.2,IBTRC,11,0))
  1. 	S ^TMP($J,"IBT",356.2,IBTRC,12,0)=$G(^IBT(356.2,IBTRC,12,0))
  1. 	S ^TMP($J,"IBT",356.2,IBTRC,13,0)=$G(^IBT(356.2,IBTRC,13,0))
  1. 	Q
  1. 	;
  1. COMP	; -- Compare before editing with globals
  1. 	S IBDIF=0
  1. 	I $G(^IBT(356.2,IBTRC,0))'=$G(^TMP($J,"IBT",356.2,IBTRC,0)) S IBDIF=1 Q
  1. 	I $G(^IBT(356.2,IBTRC,1))'=$G(^TMP($J,"IBT",356.2,IBTRC,1)) S IBDIF=1 Q
  1. 	I $G(^IBT(356.2,IBTRC,11,0))'=$G(^TMP($J,"IBT",356.2,IBTRC,11,0)) S IBDIF=1 Q
  1. 	I $G(^IBT(356.2,IBTRC,12,0))'=$G(^TMP($J,"IBT",356.2,IBTRC,12,0)) S IBDIF=1 Q
  1. 	I $G(^IBT(356.2,IBTRC,13,0))'=$G(^TMP($J,"IBT",356.2,IBTRC,13,0)) S IBDIF=1 Q
  1. 	Q
  1. 	;
  1. UPDATE	; -- enter date and user if editing has taken place
  1. 	;    entry locked during edit lock not needed here
  1. 	S DIE="^IBT(356.2,",DA=IBTRC
  1. 	S DR="1.03///NOW;1.04////"_DUZ
  1. 	D ^DIE K DA,DR,DIC,DIE
  1. 	Q
  1. 	;
  1. LOCKED	; -- write locked message
  1. 	Q:$D(ZTQUEUED)
  1. 	W !!,"Sorry, another user currently editing this entry."
  1. 	W !,"Try again later."
  1. 	D PAUSE^VALM1
  1. 	Q
  1. 	;
  1. CON	; -- consistency checker for insurance reviews
  1. 	N I,J,X,Y,DA,DR,DIC,DIE,IBI,IBDEL,IBACTION
  1. 	S IBCON=1
  1. 	S IBACTION=$P($G(^IBE(356.7,+$P(^IBT(356.2,IBTRC,0),"^",11),0)),"^",3)
  1. 	I $G(IBACTION)="" S IBACTION=99
  1. 	;
  1. 	; -- if action and type the same okay, check nxt rv. dates
  1. 	I $P($G(^IBT(356.2,IBTRC,0)),"^",4)=$P($G(^TMP($J,"IBT",356.2,IBTRC,0)),"^",4),$P($G(^IBT(356.2,IBTRC,0)),"^",11)=$P($G(^TMP($J,"IBT",356.2,IBTRC,0)),"^",11) G NXRV
  1. 	;
  1. 	; -- if action different
  1. 	I $P($G(^TMP($J,"IBT",356.2,IBTRC,0)),"^",11)="" Q  ; no previous action
  1. 	I $P($G(^IBT(356.2,IBTRC,0)),"^",11)'=$P($G(^TMP($J,"IBT",356.2,IBTRC,0)),"^",11) D
  1. 	.S DR=$P($T(@(IBACTION)),";;",2,99)
  1. 	.I DR'="" D EDIT(DR,1)
  1. 	.I IBACTION'=10 S $P(^IBT(356.2,IBTRC,0),"^",12,13)="^"
  1. 	.I IBACTION'=20 S $P(^IBT(356.2,IBTRC,0),"^",15,16)="^"
  1. 	.W !,"WARNING: I detected you changed the Action on this review and deleted",!,"data associated with the previous action." H 3
  1. 	.Q
  1. 	; -- if not denial and denial reasons delete
  1. 	I $O(^IBT(356.2,IBTRC,12,0)),$G(IBACTION)'=20 D
  1. 	.S IBI=0 F  S IBI=$O(^IBT(356.2,IBTRC,12,IBI)) Q:'IBI  S DA=IBI,DA(1)=IBTRC,DIK="^IBT(356.2,"_IBTRC_",12," D ^DIK
  1. 	;
  1. 	; -- if not penalty and penalty reasons delete
  1. 	I $O(^IBT(356.2,IBTRC,13,0)),$G(IBACTION)'=30 D
  1. 	.S IBI=0 F  S IBI=$O(^IBT(356.2,IBTRC,13,IBI)) Q:'IBI  S DA=IBI,DA(1)=IBTRC,DIK="^IBT(356.2,"_IBTRC_",13," D ^DIK
  1. 	.Q
  1. 	;
  1. NXRV	; -- check Next Review Dates
  1. 	I '$D(IBTRN) N IBTRN S IBTRN=$P($G(^IBT(356.2,+$G(IBTRC),0)),"^",2)
  1. 	Q:'$G(IBTRN)
  1. 	S IBI=0 F  S IBI=$O(^IBT(356.2,"C",IBTRN,IBI)) Q:'IBI  I IBI'=IBTRC D
  1. 	.I $P($G(^IBT(356.2,IBI,0)),"^",24) S IBI(IBI)=""
  1. 	.Q
  1. 	I $O(IBI(0)) D ASKDEL I IBDEL D
  1. 	.I $P(^IBT(356.2,IBTRC,0),U,24) W !,"Warning: There are other reviews with Next Review Dates specified.",!,"Generally only the last review date should have a Next Review Date." H 3 Q
  1. 	.I $O(IBI(+$O(IBI(0)))) W !,"Warning:  More that one review has a Next Review Date Specified.",!,"Generally only the last review date should have a Next Review Date." H 3 Q
  1. 	.Q
  1. 	Q
  1. 	;
  1. ASKDEL	; -- ask if okay to delete next review dates
  1. 	S IBDEL=1
  1. 	Q
  1. 	;
  1. 10	;;1.07///@;.2///@;.21///@
  1. 20	;;.14///@;1.08///@;.2///@;21///@;.28///@
  1. 30	;;.14///@;1.07///@;1.08///@;.2///@;21///@;.28///@
  1. 40	;;.14///@;1.07///@;1.08///@;21///@;.28///@
  1. 50	;;.14///@;1.07///@;1.08///@;.2///@;.28///@
  1. 99	;;.14///@;1.07///@;1.08///@;.2///@;21///@;.28///@