- 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 Mar 13, 2025@21:29:51 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 ;
