IBNCPDR1.m

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 ---IBNCPDR1   1145     printed  Apr 09, 2024@21:15:37                                                                                                                                                                                                    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       ;