IBNCPDR1 ;ALB/BDB - ROI MANAGEMENT ;30-NOV-07
;;2.0;INTEGRATED BILLING;**384,550**; 21-MAR-94;Build 25
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; -- ROI Update
D FULL^VALM1 W !!
N IBDIF,DA,DR,DIC,DIE,DGSENFLG,IBEFF,IBROI
L +^IBT(356.25,IBNCRPR):5 I '$T D LOCKED^IBTRCD1 G ROIQ
S DIE="^IBT(356.25,",DA=IBNCRPR,DIE("NO^")="BACK",DR="@1;.05;S IBEFF=X;.06;I X<IBEFF W !,"" EXPIRATION DATE < EFFECTIVE DATE ??"" S Y=""@1"";.07;2.01"
D ^DIE K DIC,DIE,DA,DR
S IBDIF=0
I $G(^IBT(356.25,IBNCRPR,0))'=$G(TMP("IBNCR",$J,"ROI0")) S IBDIF=1
I $G(^IBT(356.25,IBNCRPR,1))'=$G(TMP("IBNCR",$J,"ROI1")) S IBDIF=1
I $G(^IBT(356.25,IBNCRPR,2))'=$G(TMP("IBNCR",$J,"ROI2")) S IBDIF=1
I IBDIF D UPDATE,BLD^IBNCPDR5
L -^IBT(356.25,IBNCRPR)
S ZTIO="",ZTRTN="CTCLN^IBNCPDR2",ZTSAVE("IBNCRPR")="",ZTDTH=$H,ZTDESC="IB - Make ROI Pharmacy entries in Claims Tracking billable"
D ^%ZTLOAD K ZTSK,ZTIO,ZTSAVE,ZTDESC,ZTRTN
;D CTCLN^IBNCPDR2
ROIQ S VALMBCK="R" Q
;
UPDATE ; -- Update last edited by
N DA,DIC,DIE,DR
S DIE="^IBT(356.25,",DA=IBNCRPR,DR="1.03///NOW;1.04////"_DUZ
D ^DIE
S VALMBCK="R" Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPDR1 1145 printed Dec 13, 2024@02:24:50 Page 2
IBNCPDR1 ;ALB/BDB - ROI MANAGEMENT ;30-NOV-07
+1 ;;2.0;INTEGRATED BILLING;**384,550**; 21-MAR-94;Build 25
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; -- ROI Update
+1 DO FULL^VALM1
WRITE !!
+2 NEW IBDIF,DA,DR,DIC,DIE,DGSENFLG,IBEFF,IBROI
+3 LOCK +^IBT(356.25,IBNCRPR):5
IF '$TEST
DO LOCKED^IBTRCD1
GOTO ROIQ
+4 SET DIE="^IBT(356.25,"
SET DA=IBNCRPR
SET DIE("NO^")="BACK"
SET DR="@1;.05;S IBEFF=X;.06;I X<IBEFF W !,"" EXPIRATION DATE < EFFECTIVE DATE ??"" S Y=""@1"";.07;2.01"
+5 DO ^DIE
KILL DIC,DIE,DA,DR
+6 SET IBDIF=0
+7 IF $GET(^IBT(356.25,IBNCRPR,0))'=$GET(TMP("IBNCR",$JOB,"ROI0"))
SET IBDIF=1
+8 IF $GET(^IBT(356.25,IBNCRPR,1))'=$GET(TMP("IBNCR",$JOB,"ROI1"))
SET IBDIF=1
+9 IF $GET(^IBT(356.25,IBNCRPR,2))'=$GET(TMP("IBNCR",$JOB,"ROI2"))
SET IBDIF=1
+10 IF IBDIF
DO UPDATE
DO BLD^IBNCPDR5
+11 LOCK -^IBT(356.25,IBNCRPR)
+12 SET ZTIO=""
SET ZTRTN="CTCLN^IBNCPDR2"
SET ZTSAVE("IBNCRPR")=""
SET ZTDTH=$HOROLOG
SET ZTDESC="IB - Make ROI Pharmacy entries in Claims Tracking billable"
+13 DO ^%ZTLOAD
KILL ZTSK,ZTIO,ZTSAVE,ZTDESC,ZTRTN
+14 ;D CTCLN^IBNCPDR2
ROIQ SET VALMBCK="R"
QUIT
+1 ;
UPDATE ; -- Update last edited by
+1 NEW DA,DIC,DIE,DR
+2 SET DIE="^IBT(356.25,"
SET DA=IBNCRPR
SET DR="1.03///NOW;1.04////"_DUZ
+3 DO ^DIE
+4 SET VALMBCK="R"
QUIT
+5 ;
