IBNCPDR ;ALB/BDB - ROI MANAGEMENT, LIST MANAGER ;30-NOV-07
;;2.0;INTEGRATED BILLING;**384,550**;21-MAR-94;Build 25
;;Per VA Directive 6402, this routine should not be modified.
;
;Reference to $$PSSBILSD^PSS50 is supported by IA# 6245
;
% ; -- main entry point
EN ;
D DT^DICRW
K XQORS,VALMEVL
D EN^VALM("IBNCR PATIENT RELEASE OF INFO")
ENQ K DFN
Q
;
;
INIT ; -- set up inital variables
S U="^",VALMCNT=0,VALMBG=1
K ^TMP("IBNCR",$J)
D:'$D(DFN) PAT G:$D(VALMQUIT) INITQ
D BLD
INITQ Q
;
;
PAT ; -- select patient you are working with
N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
S DIC(0)="AEQMN",DIC="^DPT(" D ^DIC K DIC I +Y<1 S VALMQUIT="" Q
S DFN=+Y
Q
;
;
BLD ; -- build list of ROI'S
K ^TMP("IBNCR",$J)
N IBNCRI,IBNCRJ,IBNCRK,IBNCRL,IBNCRM,IBNCRX,IBNCRF
S (IBNCRI,IBNCRJ,IBNCRK,IBNCRL,VALMCNT)=0
;
; -- find all ROI'S
K IBNCRJ S IBNCRJ=0
S IBNCRK=0 F S IBNCRK=$O(^IBT(356.25,"AC",DFN,IBNCRK)) Q:'IBNCRK S IBNCRL=0 F S IBNCRL=$O(^IBT(356.25,"AC",DFN,IBNCRK,IBNCRL)) Q:'IBNCRL D
.; -- add to list
. S IBNCRM=0 F S IBNCRM=$O(^IBT(356.25,"AC",DFN,IBNCRK,IBNCRL,IBNCRM)) Q:'IBNCRM D
.. S IBNCRJ=IBNCRJ+1,IBNCRX=""
.. S IBNCRX=$$SETFLD^VALM1(IBNCRJ,IBNCRX,"NUMBER")
.. S IBNCRF=^IBT(356.25,IBNCRM,0)
.. I $P(IBNCRF,"^",7)="0" S IBNCRX=IBNCRX_"I "
.. S IBNCRX=$$SETFLD^VALM1($$DRUG^IBRXUTL1(IBNCRK),IBNCRX,"DRUG")
.. I $D(^DIC(36,+IBNCRL,0)) S IBNCRX=$$SETFLD^VALM1($P(^(0),"^"),IBNCRX,"INSUR")
.. S IBNCRX=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBNCRF,"^",5)),IBNCRX,"EFFDT")
.. I $P(IBNCRF,"^",6)]"" S IBNCRX=IBNCRX_"thru"
.. S IBNCRX=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBNCRF,"^",6)),IBNCRX,"EXPIRE")
.. D SET(IBNCRX)
BLDQ ;
I VALMCNT=0 D SET(" -- No ROI's on file for patient --")
Q
;
SET(X) ; -- set arrays
S VALMCNT=VALMCNT+1,^TMP("IBNCR",$J,VALMCNT,0)=X
S ^TMP("IBNCR",$J,"IDX",VALMCNT,IBNCRJ)=""
S ^TMP("IBNCRDX",$J,IBNCRJ)=$G(IBNCRM)
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("IBNCR",$J)
D CLEAN^VALM10
K VA,VAERR
Q
;
SENS(DRUG,IBBDAR) ; Sensitive Diagnosis Drug API
; Input: DRUG = drug file ien
; Output: IBBDAR (optional parameter) Pass by reference. Array of values for ECME processing
; Function value: 1 if the drug is a sensitive diagnosis drug, 0 otherwise
;
N EPHNODE
I '$G(DRUG) Q 0
S EPHNODE=$$PSSBILSD^PSS50(DRUG) ;using PSS API to obtain this information IA#6245
S IBBDAR("DRUG-SENSITIVE DX")=$P(EPHNODE,U,4)
I $P(EPHNODE,U,4)=1 Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPDR 2699 printed Sep 23, 2025@20:01:09 Page 2
IBNCPDR ;ALB/BDB - ROI MANAGEMENT, LIST MANAGER ;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 ;
+4 ;Reference to $$PSSBILSD^PSS50 is supported by IA# 6245
+5 ;
% ; -- main entry point
EN ;
+1 DO DT^DICRW
+2 KILL XQORS,VALMEVL
+3 DO EN^VALM("IBNCR PATIENT RELEASE OF INFO")
ENQ KILL DFN
+1 QUIT
+2 ;
+3 ;
INIT ; -- set up inital variables
+1 SET U="^"
SET VALMCNT=0
SET VALMBG=1
+2 KILL ^TMP("IBNCR",$JOB)
+3 if '$DATA(DFN)
DO PAT
if $DATA(VALMQUIT)
GOTO INITQ
+4 DO BLD
INITQ QUIT
+1 ;
+2 ;
PAT ; -- select patient you are working with
+1 ;Suppress PATIENT file fuzzy lookups
NEW DPTNOFZY
SET DPTNOFZY=1
+2 SET DIC(0)="AEQMN"
SET DIC="^DPT("
DO ^DIC
KILL DIC
IF +Y<1
SET VALMQUIT=""
QUIT
+3 SET DFN=+Y
+4 QUIT
+5 ;
+6 ;
BLD ; -- build list of ROI'S
+1 KILL ^TMP("IBNCR",$JOB)
+2 NEW IBNCRI,IBNCRJ,IBNCRK,IBNCRL,IBNCRM,IBNCRX,IBNCRF
+3 SET (IBNCRI,IBNCRJ,IBNCRK,IBNCRL,VALMCNT)=0
+4 ;
+5 ; -- find all ROI'S
+6 KILL IBNCRJ
SET IBNCRJ=0
+7 SET IBNCRK=0
FOR
SET IBNCRK=$ORDER(^IBT(356.25,"AC",DFN,IBNCRK))
if 'IBNCRK
QUIT
SET IBNCRL=0
FOR
SET IBNCRL=$ORDER(^IBT(356.25,"AC",DFN,IBNCRK,IBNCRL))
if 'IBNCRL
QUIT
Begin DoDot:1
+8 ; -- add to list
+9 SET IBNCRM=0
FOR
SET IBNCRM=$ORDER(^IBT(356.25,"AC",DFN,IBNCRK,IBNCRL,IBNCRM))
if 'IBNCRM
QUIT
Begin DoDot:2
+10 SET IBNCRJ=IBNCRJ+1
SET IBNCRX=""
+11 SET IBNCRX=$$SETFLD^VALM1(IBNCRJ,IBNCRX,"NUMBER")
+12 SET IBNCRF=^IBT(356.25,IBNCRM,0)
+13 IF $PIECE(IBNCRF,"^",7)="0"
SET IBNCRX=IBNCRX_"I "
+14 SET IBNCRX=$$SETFLD^VALM1($$DRUG^IBRXUTL1(IBNCRK),IBNCRX,"DRUG")
+15 IF $DATA(^DIC(36,+IBNCRL,0))
SET IBNCRX=$$SETFLD^VALM1($PIECE(^(0),"^"),IBNCRX,"INSUR")
+16 SET IBNCRX=$$SETFLD^VALM1($$DAT1^IBOUTL($PIECE(IBNCRF,"^",5)),IBNCRX,"EFFDT")
+17 IF $PIECE(IBNCRF,"^",6)]""
SET IBNCRX=IBNCRX_"thru"
+18 SET IBNCRX=$$SETFLD^VALM1($$DAT1^IBOUTL($PIECE(IBNCRF,"^",6)),IBNCRX,"EXPIRE")
+19 DO SET(IBNCRX)
End DoDot:2
End DoDot:1
BLDQ ;
+1 IF VALMCNT=0
DO SET(" -- No ROI's on file for patient --")
+2 QUIT
+3 ;
SET(X) ; -- set arrays
+1 SET VALMCNT=VALMCNT+1
SET ^TMP("IBNCR",$JOB,VALMCNT,0)=X
+2 SET ^TMP("IBNCR",$JOB,"IDX",VALMCNT,IBNCRJ)=""
+3 SET ^TMP("IBNCRDX",$JOB,IBNCRJ)=$GET(IBNCRM)
+4 QUIT
+5 ;
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("IBNCR",$JOB)
+2 DO CLEAN^VALM10
+3 KILL VA,VAERR
+4 QUIT
+5 ;
SENS(DRUG,IBBDAR) ; Sensitive Diagnosis Drug API
+1 ; Input: DRUG = drug file ien
+2 ; Output: IBBDAR (optional parameter) Pass by reference. Array of values for ECME processing
+3 ; Function value: 1 if the drug is a sensitive diagnosis drug, 0 otherwise
+4 ;
+5 NEW EPHNODE
+6 IF '$GET(DRUG)
QUIT 0
+7 ;using PSS API to obtain this information IA#6245
SET EPHNODE=$$PSSBILSD^PSS50(DRUG)
+8 SET IBBDAR("DRUG-SENSITIVE DX")=$PIECE(EPHNODE,U,4)
+9 IF $PIECE(EPHNODE,U,4)=1
QUIT 1
+10 QUIT 0
