IBNCPDR5 ;ALB/BDB - ROI MANAGEMENT, EXPAND ROI ;30-NOV-07
;;2.0;INTEGRATED BILLING;**384**; 21-MAR-94;Build 74
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;
VP ; -- View Patient ROI Info
N I,J,IBNCRXX,VALMY,IBNCRPR
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBNCRXX=0 F S IBNCRXX=$O(VALMY(IBNCRXX)) Q:'IBNCRXX D
.S IBNCRPR=$G(^TMP("IBNCRDX",$J,IBNCRXX))
.Q:IBNCRPR=""
.D EN^VALM("IBNCR EXPANDED ROI")
.Q
D FULL^VALM1
D BLD^IBNCPDR
Q
;
INIT ; -- set up inital variables
S U="^",VALMCNT=14,VALMBG=1
K ^TMP("IBNCRVR",$J)
D BLD^IBNCPDR5
INITQ Q
;
BLD ; -- expand the ROI
N IBNCR0,IBNCR1,IBNCR2,IBNCRJ,IBNCROFF
D KILL^VALM10()
F I=1:1:14 D BLANK(.I)
S IBNCRJ=0,IBNCROFF=1
D SET(IBNCRJ+1,2,$E($P($G(^DPT(DFN,0)),"^"),1,20)_" has the following ROI on file:")
S IBNCR0=$G(^IBT(356.25,IBNCRPR,0)),IBNCR1=$G(^(1)),IBNCR2=$G(^(2))
S ^TMP("IBNCR",$J,"ROI0")=IBNCR0,^("ROI1")=IBNCR1,^("ROI2")=IBNCR2
D SET(IBNCRJ+3,2,"Drug: "_$$DRUG^IBRXUTL1($P(IBNCR0,U,3)))
I $D(^DIC(36,$P(IBNCR0,U,4),0)) D SET(IBNCRJ+4,2,"Insurance Company: "_$P(^(0),"^"))
D SET(IBNCRJ+5,2,"Effective Date: "_$$DAT1^IBOUTL($P(IBNCR0,"^",5)))
D SET(IBNCRJ+6,2,"Expiration Date: "_$$DAT1^IBOUTL($P(IBNCR0,"^",6)))
D SET(IBNCRJ+7,2,"Status: Active ")
I $P(IBNCR0,U,7)="0" D SET(IBNCRJ+7,2,"Status: Inactive")
D SET(IBNCRJ+8,2,"Comment: "_$P(IBNCR2,"^",1))
D SET(IBNCRJ+10,IBNCROFF," Date ROI Added: "_$$DAT1^IBOUTL($P(IBNCR1,U,1)))
D SET(IBNCRJ+11,IBNCROFF," User Adding Entry: "_$$USR^IBNCPEV($P(IBNCR1,U,2)))
D SET(IBNCRJ+12,IBNCROFF," Date ROI Last Updated: "_$$DAT1^IBOUTL($P(IBNCR1,U,3)))
D SET(IBNCRJ+13,IBNCROFF," User Last Updating: "_$$USR^IBNCPEV($P(IBNCR1,U,4)))
D SET(IBNCRJ+14,IBNCROFF," Date Last Used: "_$$DAT1^IBOUTL($P(IBNCR1,U,5)))
BLDQ ;
Q
;
BLANK(LINE) ; -- Build blank line
D SET^VALM10(.LINE,$J("",80))
Q
;
SET(LINE,COL,TEXT,ON,OFF) ; -- set display info in array
D:'$D(@VALMAR@(LINE,0)) BLANK(.LINE)
D SET^VALM10(.LINE,$$SETSTR^VALM1(.TEXT,@VALMAR@(LINE,0),.COL,$L(TEXT)))
;S VALMCNT=VALMCNT+1
D:$G(ON)]""!($G(OFF)]"") CNTRL^VALM10(.LINE,.COL,$L(TEXT),$G(ON),$G(OFF))
Q
;
HDR ; -- screen header for initial screen
D PID^VADPT
S VALMHDR(1)="ROI Management for Patient: "_$E($P($G(^DPT(DFN,0)),"^"),1,20)_" "_$E($G(^(0)),1)_VA("BID")
S VALMHDR(2)=" "
Q
;
FNL ; -- exit and clean up
K ^TMP("IBNCRVR",$J)
K IBFASTXT
D CLEAN^VALM10
K VA,VAERR
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPDR5 2571 printed Dec 13, 2024@02:24:53 Page 2
IBNCPDR5 ;ALB/BDB - ROI MANAGEMENT, EXPAND ROI ;30-NOV-07
+1 ;;2.0;INTEGRATED BILLING;**384**; 21-MAR-94;Build 74
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
VP ; -- View Patient ROI Info
+1 NEW I,J,IBNCRXX,VALMY,IBNCRPR
+2 DO EN^VALM2($GET(XQORNOD(0)))
+3 IF $DATA(VALMY)
SET IBNCRXX=0
FOR
SET IBNCRXX=$ORDER(VALMY(IBNCRXX))
if 'IBNCRXX
QUIT
Begin DoDot:1
+4 SET IBNCRPR=$GET(^TMP("IBNCRDX",$JOB,IBNCRXX))
+5 if IBNCRPR=""
QUIT
+6 DO EN^VALM("IBNCR EXPANDED ROI")
+7 QUIT
End DoDot:1
+8 DO FULL^VALM1
+9 DO BLD^IBNCPDR
+10 QUIT
+11 ;
INIT ; -- set up inital variables
+1 SET U="^"
SET VALMCNT=14
SET VALMBG=1
+2 KILL ^TMP("IBNCRVR",$JOB)
+3 DO BLD^IBNCPDR5
INITQ QUIT
+1 ;
BLD ; -- expand the ROI
+1 NEW IBNCR0,IBNCR1,IBNCR2,IBNCRJ,IBNCROFF
+2 DO KILL^VALM10()
+3 FOR I=1:1:14
DO BLANK(.I)
+4 SET IBNCRJ=0
SET IBNCROFF=1
+5 DO SET(IBNCRJ+1,2,$EXTRACT($PIECE($GET(^DPT(DFN,0)),"^"),1,20)_" has the following ROI on file:")
+6 SET IBNCR0=$GET(^IBT(356.25,IBNCRPR,0))
SET IBNCR1=$GET(^(1))
SET IBNCR2=$GET(^(2))
+7 SET ^TMP("IBNCR",$JOB,"ROI0")=IBNCR0
SET ^("ROI1")=IBNCR1
SET ^("ROI2")=IBNCR2
+8 DO SET(IBNCRJ+3,2,"Drug: "_$$DRUG^IBRXUTL1($PIECE(IBNCR0,U,3)))
+9 IF $DATA(^DIC(36,$PIECE(IBNCR0,U,4),0))
DO SET(IBNCRJ+4,2,"Insurance Company: "_$PIECE(^(0),"^"))
+10 DO SET(IBNCRJ+5,2,"Effective Date: "_$$DAT1^IBOUTL($PIECE(IBNCR0,"^",5)))
+11 DO SET(IBNCRJ+6,2,"Expiration Date: "_$$DAT1^IBOUTL($PIECE(IBNCR0,"^",6)))
+12 DO SET(IBNCRJ+7,2,"Status: Active ")
+13 IF $PIECE(IBNCR0,U,7)="0"
DO SET(IBNCRJ+7,2,"Status: Inactive")
+14 DO SET(IBNCRJ+8,2,"Comment: "_$PIECE(IBNCR2,"^",1))
+15 DO SET(IBNCRJ+10,IBNCROFF," Date ROI Added: "_$$DAT1^IBOUTL($PIECE(IBNCR1,U,1)))
+16 DO SET(IBNCRJ+11,IBNCROFF," User Adding Entry: "_$$USR^IBNCPEV($PIECE(IBNCR1,U,2)))
+17 DO SET(IBNCRJ+12,IBNCROFF," Date ROI Last Updated: "_$$DAT1^IBOUTL($PIECE(IBNCR1,U,3)))
+18 DO SET(IBNCRJ+13,IBNCROFF," User Last Updating: "_$$USR^IBNCPEV($PIECE(IBNCR1,U,4)))
+19 DO SET(IBNCRJ+14,IBNCROFF," Date Last Used: "_$$DAT1^IBOUTL($PIECE(IBNCR1,U,5)))
BLDQ ;
+1 QUIT
+2 ;
BLANK(LINE) ; -- Build blank line
+1 DO SET^VALM10(.LINE,$JUSTIFY("",80))
+2 QUIT
+3 ;
SET(LINE,COL,TEXT,ON,OFF) ; -- set display info in array
+1 if '$DATA(@VALMAR@(LINE,0))
DO BLANK(.LINE)
+2 DO SET^VALM10(.LINE,$$SETSTR^VALM1(.TEXT,@VALMAR@(LINE,0),.COL,$LENGTH(TEXT)))
+3 ;S VALMCNT=VALMCNT+1
+4 if $GET(ON)]""!($GET(OFF)]"")
DO CNTRL^VALM10(.LINE,.COL,$LENGTH(TEXT),$GET(ON),$GET(OFF))
+5 QUIT
+6 ;
HDR ; -- screen header for initial screen
+1 DO PID^VADPT
+2 SET VALMHDR(1)="ROI Management for Patient: "_$EXTRACT($PIECE($GET(^DPT(DFN,0)),"^"),1,20)_" "_$EXTRACT($GET(^(0)),1)_VA("BID")
+3 SET VALMHDR(2)=" "
+4 QUIT
+5 ;
FNL ; -- exit and clean up
+1 KILL ^TMP("IBNCRVR",$JOB)
+2 KILL IBFASTXT
+3 DO CLEAN^VALM10
+4 KILL VA,VAERR
+5 QUIT
+6 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
