IBNCPDR.m

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 ---IBNCPDR   2699     printed  Mar 13, 2025@21:29:50                                                                                                                                                                                                     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