Routine: IBNCPEV3

IBNCPEV3 ;ALB/DMB - ECME RXS WITH NON-BILLABLE STATUS ;5/22/08

 ;;2.0;INTEGRATED BILLING;**534,617**;21-MAR-94;Build 43

 ;;Per VA Directive 6402, this routine should not be modified.

 ; ICR #6131 documents the usage of this entry point by the ECME application

COLLECT(BEGDT,ENDDT,MWC,RELNRL,IBDRUG,DRUGCLS,ALLRCNT,IBPHARM,IBINS,IBNBSTS,IBELIG1,IBGLTMP,IBPAT,IBBILL,IBMIN,IBMAX) ;

 ; Compile the data for the new Non-Billable Status report

 ; Input:

 ;    BEGDT - Beginning Date

 ;    ENDDT - Ending Date

 ;      MWC - A:All; M:Mail; W:Window; C:CMOP, if multiple entries MWC="C,M"

 ;   RELNRL - 1:All; 2:Released; 3:Not Released

 ;   IBDRUG - 0:All; DRUG to report on (ptr to #50), if multiple entries IBDRUG=ptr,ptr,...

 ;  DRUGCLS - 0:All; DRUG CLASS to report on (ptr to #50.5), if multiple entries DRUGCLS=ptr,ptr,...

 ;  ALLRCNT - A:All; R:Most recent

 ;  IBPHARM/IBPHARM(ptr) - 0:All pharmacies; 1:Array of IENs of pharmacies

 ;  IBINS/IBINS(ptr) - 0:All insurances or list of file 36 IENs

 ;  IBNBSTS/IBNBSTS(x) - 0:All; 1:Array of Non-Billable Status

 ;  IBELIG1/IBELIG1(x) - 0:All; 1:Array of multiple eligibilities

 ;  IBGLTMP - Temporary Global Storage (returned with extracted data)

 ;  IBPAT - 0:All; ptr to #2 PATIENT, IBPAT=ptr,ptr,...

 ;  IBBILL - 0:All; 1:Range of Billed Amount - then check IBMIN and IBMAX

 ;    IBMIN=minimum billed amount entered, default is 0

 ;    IBMAX=maximum billed amount entered, default is 999999

 ; Output:

 ;    1 - Successful

 ;   -1 - Unsuccessful

 ; Check Parameters

 I $G(IBGLTMP)="" Q -1

 N DATE,IEN,IEN1,X,X0,X2,X7,DIV,INS,RX,FILL,DRUG,RLDT,ELIG

 N DFN,DRGCOST,I,IBDGLCS,IBSTOP,STATUS

 K ^TMP($J)

 ; Loop through the IB NCPDP Event Log for the data range

 S DATE=BEGDT-.1 F  S DATE=$O(^IBCNR(366.14,"B",DATE)) Q:'DATE!(DATE>ENDDT)  D

 . S IEN="" F  S IEN=$O(^IBCNR(366.14,"B",DATE,IEN)) Q:'IEN  D

 .. S IEN1=0 F  S IEN1=$O(^IBCNR(366.14,IEN,1,IEN1)) Q:'IEN1  D

 ... S X0=$G(^IBCNR(366.14,IEN,1,IEN1,0))

 ... ;

 ... ; If not a Billable Status Check, quit

 ... I +X0'=1 Q

 ... ;

 ... ; If successful, quit

 ... I $P(X0,"^",7)'=0 Q

 ... ;

 ... ; Check Non-Status Reason matches user input

 ... I IBNBSTS=1,'$D(IBNBSTS(+$P(X0,U,2))) Q

 ... ;

 ... ; Check Division matches user input

 ... S DIV=+$P(X0,U,9)

 ... I IBPHARM=1,'$D(IBPHARM(DIV)) Q

 ... ;

 ... ; Check Insurance matches user input

 ... S INS=$$GETINS(IEN,IEN1)

 ... I IBINS'=0,'$$CHKINS(IBINS,+INS) Q

 ... S INS=$P(INS,"^",2)

 ... ;

 ... ; Get Rx and Fill

 ... S X2=$G(^IBCNR(366.14,IEN,1,IEN1,2))

 ... S RX=$P(X2,U,12),FILL=$P(X2,U,3)

 ... I 'RX S RX=$P(X2,U,2)

 ... I 'RX Q

 ... ;

 ... ; Check Fill Type matches user input

 ... I MWC'="A",MWC'[$$MWC^PSOBPSU2(RX,FILL) Q

 ... ;

 ... ; Check Drug matches user input

 ... S DRUG=$$FILE^IBRXUTL(RX,6,"I")

 ... I IBDRUG D  I IBSTOP=0 Q

 .... S IBSTOP=0

 .... F I=1:1:$L(IBDRUG,",") I DRUG=$P(IBDRUG,",",I) S IBSTOP=1 Q

 ... ;

 ... ; Check Drug Class matches user input

 ... S IBDGCLS=$$CLSNAME^IBNCPEV3($$GETDRGCL^IBNCPEV3(DRUG),99)

 ... I DRUGCLS'=0 D  I IBSTOP=0 Q

 .... S IBSTOP=0

 .... F I=1:1:$L(DRUGCLS,";") I IBDGCLS=$P(DRUGCLS,";",I) S IBSTOP=1 Q

 ... ;

 ... ; Check Released matches user input

 ... S RLDT=$P($$RXRLDT^PSOBPSUT(RX,FILL),".")

 ... I RELNRL'=1 Q:RELNRL=2&'RLDT  Q:RELNRL=3&RLDT

 ... ;

 ... ; Check Eligibilities matches user input

 ... S X7=$G(^IBCNR(366.14,IEN,1,IEN1,7))

 ... S ELIG=$P(X7,U,5)

 ... I IBELIG1=1,'$D(IBELIG1(ELIG)) Q

 ... ;

 ... ; Check Patient(s) matches user input

 ... S DFN=+$P(X0,U,3)

 ... I IBPAT'=0 D  I IBSTOP=0 Q

 .... S IBSTOP=0

 .... F I=1:1:$L(IBPAT,",") I $P(IBPAT,",",I)=DFN S IBSTOP=1 Q

 ... ;

 ... ; Check Drug Cost matches Bill Amount user input

 ... S DRGCOST=$$COST(RX,FILL)

 ... I IBBILL'=0 I (DRGCOST<$G(IBMIN))!(DRGCOST>$G(IBMAX)) Q

 ... ;

 ... ; Get Data

 ... ;  Division, Insurance, Patient Name, SSN, Eligibility, RX, Fill

 ... ;  Date, Drug Cost, Drug, Released On, Fill Type,

 ... ;  Status (RX status/Released-Not released)

 ... S STATUS=$$RXAPI1^IBNCPUT1(RX,100,"I")

 ... ; If most recent, temporary Sort by RX and Fill

 ... ; Else store in the global

 ... I ALLRCNT="R" S ^TMP($J,"IBNCPEV3",+RX,+FILL,DATE)=DIV_U_INS_U_DFN_U_ELIG_U_DRGCOST_U_0_U_DRUG_U_RLDT_U_STATUS_U_$P(X0,U,2)

 ... E  S @IBGLTMP@(DIV,INS,+DFN,DATE,+RX,+FILL)=ELIG_U_DRGCOST_U_0_U_DRUG_U_RLDT_U_STATUS_U_$P(X0,U,2)

 ; If most recent, get most recent record for each RX and fill and populate the array

 I ALLRCNT="R" D

 . S RX="" F  S RX=$O(^TMP($J,"IBNCPEV3",RX)) Q:'RX  D

 .. S FILL="" F  S FILL=$O(^TMP($J,"IBNCPEV3",RX,FILL)) Q:FILL=""  D

 ... S DATE=$O(^TMP($J,"IBNCPEV3",RX,FILL,""),-1)

 ... S X=$G(^TMP($J,"IBNCPEV3",RX,FILL,DATE)),DIV=$P(X,U,1),INS=$P(X,U,2),DFN=$P(X,U,3)

 ... S @IBGLTMP@(DIV,INS,+DFN,DATE,RX,FILL)=$P(X,U,4,10)

 . ; Clean up scratch global

 . K ^TMP($J,"IBNCPEV3")

Q 1

DRUGDIE(IEN,FLD,FORMAT,IBARR) ;

 ;  Return field values for Drug file

 ;  Function returns field data if one field is specified. If

 ;    multiple fields, the function will return "" and the field

 ;    values are returned in IBARR

 ; Example: W $$DRUGDIE^IBNCPEV3(134,25,"E",.ARR)

 ;  IEN - IEN of DRUG FILE #50

 ;  FLD - Field Number(s) (like .01)

 ;  FORMAT - Specifies internal or external value of returned field

 ;         - optional, defaults to "I"

 ;  IBARR - Array to return value(s). Optional. Pass by reference.

 ;           See EN^DIQ documentation for variable DIQ

 I $G(IEN)="" Q ""

 I $G(FLD)="" Q ""

 I $G(FORMAT)'="E" S FORMAT="I"

 N DIQ,PSSDIY,IBDIQ

 S IBDIQ="IBARR",IBDIQ(0)=FORMAT

 D EN^PSSDI(50,"IB",50,.FLD,.IEN,.IBDIQ)

 Q $G(IBARR(50,IEN,FLD,FORMAT))

CLSNAME(CLASS,IBLEN) ;

 ; Get Drug Class Name

 I $G(CLASS)="" Q ""

 K ^TMP($J,"IBPEV-CLASS")

 N Y,IEN

 S Y=""

 D C^PSN50P65(CLASS,"","IBPEV-CLASS")

 S IEN=$O(^TMP($J,"IBPEV-CLASS",0))

 I IEN]"" S Y=$E($G(^TMP($J,"IBPEV-CLASS",IEN,1)),1,IBLEN)

 K ^TMP($J,"IBPEV-CLASS")

Q Y

GETINS(IEN,IEN1) ;

 ;Get the Insurance from INSURANCE multiple

 ;Input: IEN  = IEN of the IB NCPCP BILLING EVENT LOG

 ;       IEN1 = IEN of the EVENT subfile

 ;Output: Insurance Company Pointer or null if not found

 I '$G(IEN) Q "0^UNKNOWN INSURANCE"

 I '$G(IEN1) Q "0^UNKNOWN INSURANCE"

 ; Get Group Plan from first INSURANCE multiple entry

 N IEN2,GPLAN,INS,INSNM

 S IEN2=$O(^IBCNR(366.14,IEN,1,IEN1,5,0))

 I 'IEN2 Q "0^UNKNOWN INSURANCE"

 S GPLAN=$P($G(^IBCNR(366.14,IEN,1,IEN1,5,IEN2,0)),"^",2)

 I 'GPLAN Q "0^UNKNOWN INSURANCE"

 ; Get Insurance Company from the Group Plan record

 S INS=+$G(^IBA(355.3,GPLAN,0))

 I INS=0 Q "0^UNKNOWN INSURANCE"

 S INSNM=$$GET1^DIQ(36,INS,.01,"E")

 I INSNM="" S INSNM="UNKNOWN INSURANCE"

 Q INS_"^"_INSNM

CHKINS(LIST,INS) ;

 ;Check if the IB NCPDP EVENT LOG has the user-entered insurance

 ;Input: LIST = Semi-colon separated list of Insurances selected by the user

 ;       INS  = IEN of the Insurance Company (#36) file

 ;Output: 1 = Match found

 ;        0 = No match found

 I $G(LIST)="" Q 0

 I '$G(INS) Q 0

 N I,IN1,RETV

 S RETV=0

 F I=2:1 S IN1=$P($G(LIST),";",I) Q:IN1=""  S RETV=$S(IN1=INS:1,1:0) Q:RETV

 Q RETV

COST(RX,FILL) ;

 ; Calculate Drug Cost for RX/Fill

 ; Input:

 ;   RX:   Prescription IEN

 ;   FILL: Fill Number

 ; Output:

 ;   Drug Cost

 I '$G(RX) Q ""

 I $G(FILL)="" Q ""

 N DATA,COST,QTY

 I FILL=0 S COST=$$FILE^IBRXUTL(RX,17,"I"),QTY=$$FILE^IBRXUTL(RX,7,"I")

 I FILL S COST=$$SUBFILE^IBRXUTL(RX,FILL,"",1.2,"I"),QTY=$$SUBFILE^IBRXUTL(RX,FILL,"",1,"I")

 Q COST*QTY

 ;Get VA DRUG CLASS pointer

 ; Input Variables: BP50 - ptr to DRUG (#50)

 ; Return Value -> n = ptr to VA DRUG CLASS (#50.605)

 ;                 0 = Unknown

GETDRGCL(BP50) Q $$DRUGDIE(BP50,25)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPEV3   7880     printed  Apr 23, 2025@18:39:36                                                                                                                                                                                                    Page 2

IBNCPEV3  ;ALB/DMB - ECME RXS WITH NON-BILLABLE STATUS ;5/22/08

 +1       ;;2.0;INTEGRATED BILLING;**534,617**;21-MAR-94;Build 43

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; ICR #6131 documents the usage of this entry point by the ECME application

 +5       ;

COLLECT(BEGDT,ENDDT,MWC,RELNRL,IBDRUG,DRUGCLS,ALLRCNT,IBPHARM,IBINS,IBNBSTS,IBELIG1,IBGLTMP,IBPAT,IBBILL,IBMIN,IBMAX) ;

 +1       ; Compile the data for the new Non-Billable Status report

 +2       ; Input:

 +3       ;    BEGDT - Beginning Date

 +4       ;    ENDDT - Ending Date

 +5       ;      MWC - A:All; M:Mail; W:Window; C:CMOP, if multiple entries MWC="C,M"

 +6       ;   RELNRL - 1:All; 2:Released; 3:Not Released

 +7       ;   IBDRUG - 0:All; DRUG to report on (ptr to #50), if multiple entries IBDRUG=ptr,ptr,...

 +8       ;  DRUGCLS - 0:All; DRUG CLASS to report on (ptr to #50.5), if multiple entries DRUGCLS=ptr,ptr,...

 +9       ;  ALLRCNT - A:All; R:Most recent

 +10      ;  IBPHARM/IBPHARM(ptr) - 0:All pharmacies; 1:Array of IENs of pharmacies

 +11      ;  IBINS/IBINS(ptr) - 0:All insurances or list of file 36 IENs

 +12      ;  IBNBSTS/IBNBSTS(x) - 0:All; 1:Array of Non-Billable Status

 +13      ;  IBELIG1/IBELIG1(x) - 0:All; 1:Array of multiple eligibilities

 +14      ;  IBGLTMP - Temporary Global Storage (returned with extracted data)

 +15      ;  IBPAT - 0:All; ptr to #2 PATIENT, IBPAT=ptr,ptr,...

 +16      ;  IBBILL - 0:All; 1:Range of Billed Amount - then check IBMIN and IBMAX

 +17      ;    IBMIN=minimum billed amount entered, default is 0

 +18      ;    IBMAX=maximum billed amount entered, default is 999999

 +19      ;

 +20      ; Output:

 +21      ;    1 - Successful

 +22      ;   -1 - Unsuccessful

 +23      ;

 +24      ; Check Parameters

 +25       IF $GET(IBGLTMP)=""

               QUIT -1

 +26      ;

 +27       NEW DATE,IEN,IEN1,X,X0,X2,X7,DIV,INS,RX,FILL,DRUG,RLDT,ELIG

 +28       NEW DFN,DRGCOST,I,IBDGLCS,IBSTOP,STATUS

 +29       KILL ^TMP($JOB)

 +30      ;

 +31      ; Loop through the IB NCPDP Event Log for the data range

 +32       SET DATE=BEGDT-.1

FOR

               SET DATE=$ORDER(^IBCNR(366.14,"B",DATE))

               if 'DATE!(DATE>ENDDT)

                   QUIT

               Begin DoDot:1

 +33               SET IEN=""

FOR

                       SET IEN=$ORDER(^IBCNR(366.14,"B",DATE,IEN))

                       if 'IEN

                           QUIT

                       Begin DoDot:2

 +34                       SET IEN1=0

FOR

                               SET IEN1=$ORDER(^IBCNR(366.14,IEN,1,IEN1))

                               if 'IEN1

                                   QUIT

                               Begin DoDot:3

 +35                               SET X0=$GET(^IBCNR(366.14,IEN,1,IEN1,0))

 +36      ;

 +37      ; If not a Billable Status Check, quit

 +38                               IF +X0'=1

                                       QUIT

 +39      ;

 +40      ; If successful, quit

 +41                               IF $PIECE(X0,"^",7)'=0

                                       QUIT

 +42      ;

 +43      ; Check Non-Status Reason matches user input

 +44                               IF IBNBSTS=1

                                       IF '$DATA(IBNBSTS(+$PIECE(X0,U,2)))

                                           QUIT

 +45      ;

 +46      ; Check Division matches user input

 +47                               SET DIV=+$PIECE(X0,U,9)

 +48                               IF IBPHARM=1

                                       IF '$DATA(IBPHARM(DIV))

                                           QUIT

 +49      ;

 +50      ; Check Insurance matches user input

 +51                               SET INS=$$GETINS(IEN,IEN1)

 +52                               IF IBINS'=0

                                       IF '$$CHKINS(IBINS,+INS)

                                           QUIT

 +53                               SET INS=$PIECE(INS,"^",2)

 +54      ;

 +55      ; Get Rx and Fill

 +56                               SET X2=$GET(^IBCNR(366.14,IEN,1,IEN1,2))

 +57                               SET RX=$PIECE(X2,U,12)

                                   SET FILL=$PIECE(X2,U,3)

 +58                               IF 'RX

                                       SET RX=$PIECE(X2,U,2)

 +59                               IF 'RX

                                       QUIT

 +60      ;

 +61      ; Check Fill Type matches user input

 +62                               IF MWC'="A"

                                       IF MWC'[$$MWC^PSOBPSU2(RX,FILL)

                                           QUIT

 +63      ;

 +64      ; Check Drug matches user input

 +65                               SET DRUG=$$FILE^IBRXUTL(RX,6,"I")

 +66                               IF IBDRUG

                                       Begin DoDot:4

 +67                                       SET IBSTOP=0

 +68                                       FOR I=1:1:$LENGTH(IBDRUG,",")

                                               IF DRUG=$PIECE(IBDRUG,",",I)

                                                   SET IBSTOP=1

                                                   QUIT

                                       End DoDot:4

                                       IF IBSTOP=0

                                           QUIT

 +69      ;

 +70      ; Check Drug Class matches user input

 +71                               SET IBDGCLS=$$CLSNAME^IBNCPEV3($$GETDRGCL^IBNCPEV3(DRUG),99)

 +72                               IF DRUGCLS'=0

                                       Begin DoDot:4

 +73                                       SET IBSTOP=0

 +74                                       FOR I=1:1:$LENGTH(DRUGCLS,";")

                                               IF IBDGCLS=$PIECE(DRUGCLS,";",I)

                                                   SET IBSTOP=1

                                                   QUIT

                                       End DoDot:4

                                       IF IBSTOP=0

                                           QUIT

 +75      ;

 +76      ; Check Released matches user input

 +77                               SET RLDT=$PIECE($$RXRLDT^PSOBPSUT(RX,FILL),".")

 +78                               IF RELNRL'=1

                                       if RELNRL=2&'RLDT

                                           QUIT

                                       if RELNRL=3&RLDT

                                           QUIT

 +79      ;

 +80      ; Check Eligibilities matches user input

 +81                               SET X7=$GET(^IBCNR(366.14,IEN,1,IEN1,7))

 +82                               SET ELIG=$PIECE(X7,U,5)

 +83                               IF IBELIG1=1

                                       IF '$DATA(IBELIG1(ELIG))

                                           QUIT

 +84      ;

 +85      ; Check Patient(s) matches user input

 +86                               SET DFN=+$PIECE(X0,U,3)

 +87                               IF IBPAT'=0

                                       Begin DoDot:4

 +88                                       SET IBSTOP=0

 +89                                       FOR I=1:1:$LENGTH(IBPAT,",")

                                               IF $PIECE(IBPAT,",",I)=DFN

                                                   SET IBSTOP=1

                                                   QUIT

                                       End DoDot:4

                                       IF IBSTOP=0

                                           QUIT

 +90      ;

 +91      ; Check Drug Cost matches Bill Amount user input

 +92                               SET DRGCOST=$$COST(RX,FILL)

 +93                               IF IBBILL'=0

                                       IF (DRGCOST<$GET(IBMIN))!(DRGCOST>$GET(IBMAX))

                                           QUIT

 +94      ;

 +95      ; Get Data

 +96      ;  Division, Insurance, Patient Name, SSN, Eligibility, RX, Fill

 +97      ;  Date, Drug Cost, Drug, Released On, Fill Type,

 +98      ;  Status (RX status/Released-Not released)

 +99                               SET STATUS=$$RXAPI1^IBNCPUT1(RX,100,"I")

 +100     ; If most recent, temporary Sort by RX and Fill

 +101     ; Else store in the global

 +102                              IF ALLRCNT="R"

                                       SET ^TMP($JOB,"IBNCPEV3",+RX,+FILL,DATE)=DIV_U_INS_U_DFN_U_ELIG_U_DRGCOST_U_0_U_DRUG_U_RLDT_U_STATUS_U_$PIECE(X0,U,2)

 +103                             IF '$TEST

                                       SET @IBGLTMP@(DIV,INS,+DFN,DATE,+RX,+FILL)=ELIG_U_DRGCOST_U_0_U_DRUG_U_RLDT_U_STATUS_U_$PIECE(X0,U,2)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +104     ;

 +105     ; If most recent, get most recent record for each RX and fill and populate the array

 +106      IF ALLRCNT="R"

               Begin DoDot:1

 +107              SET RX=""

FOR

                       SET RX=$ORDER(^TMP($JOB,"IBNCPEV3",RX))

                       if 'RX

                           QUIT

                       Begin DoDot:2

 +108                      SET FILL=""

FOR

                               SET FILL=$ORDER(^TMP($JOB,"IBNCPEV3",RX,FILL))

                               if FILL=""

                                   QUIT

                               Begin DoDot:3

 +109                              SET DATE=$ORDER(^TMP($JOB,"IBNCPEV3",RX,FILL,""),-1)

 +110                              SET X=$GET(^TMP($JOB,"IBNCPEV3",RX,FILL,DATE))

                                   SET DIV=$PIECE(X,U,1)

                                   SET INS=$PIECE(X,U,2)

                                   SET DFN=$PIECE(X,U,3)

 +111                              SET @IBGLTMP@(DIV,INS,+DFN,DATE,RX,FILL)=$PIECE(X,U,4,10)

                               End DoDot:3

                       End DoDot:2

 +112     ; Clean up scratch global

 +113              KILL ^TMP($JOB,"IBNCPEV3")

               End DoDot:1

 +114      QUIT 1

 +115     ;

 +116     ;

DRUGDIE(IEN,FLD,FORMAT,IBARR) ;

 +1       ;  Return field values for Drug file

 +2       ;  Function returns field data if one field is specified. If

 +3       ;    multiple fields, the function will return "" and the field

 +4       ;    values are returned in IBARR

 +5       ; Example: W $$DRUGDIE^IBNCPEV3(134,25,"E",.ARR)

 +6       ;  IEN - IEN of DRUG FILE #50

 +7       ;  FLD - Field Number(s) (like .01)

 +8       ;  FORMAT - Specifies internal or external value of returned field

 +9       ;         - optional, defaults to "I"

 +10      ;  IBARR - Array to return value(s). Optional. Pass by reference.

 +11      ;           See EN^DIQ documentation for variable DIQ

 +12      ;

 +13       IF $GET(IEN)=""

               QUIT ""

 +14       IF $GET(FLD)=""

               QUIT ""

 +15       IF $GET(FORMAT)'="E"

               SET FORMAT="I"

 +16       NEW DIQ,PSSDIY,IBDIQ

 +17       SET IBDIQ="IBARR"

           SET IBDIQ(0)=FORMAT

 +18       DO EN^PSSDI(50,"IB",50,.FLD,.IEN,.IBDIQ)

 +19       QUIT $GET(IBARR(50,IEN,FLD,FORMAT))

 +20      ;

CLSNAME(CLASS,IBLEN) ;

 +1       ; Get Drug Class Name

 +2        IF $GET(CLASS)=""

               QUIT ""

 +3        KILL ^TMP($JOB,"IBPEV-CLASS")

 +4        NEW Y,IEN

 +5        SET Y=""

 +6        DO C^PSN50P65(CLASS,"","IBPEV-CLASS")

 +7        SET IEN=$ORDER(^TMP($JOB,"IBPEV-CLASS",0))

 +8        IF IEN]""

               SET Y=$EXTRACT($GET(^TMP($JOB,"IBPEV-CLASS",IEN,1)),1,IBLEN)

 +9        KILL ^TMP($JOB,"IBPEV-CLASS")

 +10       QUIT Y

 +11      ;

GETINS(IEN,IEN1) ;

 +1       ;Get the Insurance from INSURANCE multiple

 +2       ;Input: IEN  = IEN of the IB NCPCP BILLING EVENT LOG

 +3       ;       IEN1 = IEN of the EVENT subfile

 +4       ;

 +5       ;Output: Insurance Company Pointer or null if not found

 +6       ;

 +7        IF '$GET(IEN)

               QUIT "0^UNKNOWN INSURANCE"

 +8        IF '$GET(IEN1)

               QUIT "0^UNKNOWN INSURANCE"

 +9       ;

 +10      ; Get Group Plan from first INSURANCE multiple entry

 +11       NEW IEN2,GPLAN,INS,INSNM

 +12       SET IEN2=$ORDER(^IBCNR(366.14,IEN,1,IEN1,5,0))

 +13       IF 'IEN2

               QUIT "0^UNKNOWN INSURANCE"

 +14       SET GPLAN=$PIECE($GET(^IBCNR(366.14,IEN,1,IEN1,5,IEN2,0)),"^",2)

 +15       IF 'GPLAN

               QUIT "0^UNKNOWN INSURANCE"

 +16      ;

 +17      ; Get Insurance Company from the Group Plan record

 +18       SET INS=+$GET(^IBA(355.3,GPLAN,0))

 +19       IF INS=0

               QUIT "0^UNKNOWN INSURANCE"

 +20       SET INSNM=$$GET1^DIQ(36,INS,.01,"E")

 +21       IF INSNM=""

               SET INSNM="UNKNOWN INSURANCE"

 +22       QUIT INS_"^"_INSNM

 +23      ;

CHKINS(LIST,INS) ;

 +1       ;Check if the IB NCPDP EVENT LOG has the user-entered insurance

 +2       ;Input: LIST = Semi-colon separated list of Insurances selected by the user

 +3       ;       INS  = IEN of the Insurance Company (#36) file

 +4       ;

 +5       ;Output: 1 = Match found

 +6       ;        0 = No match found

 +7       ;

 +8        IF $GET(LIST)=""

               QUIT 0

 +9        IF '$GET(INS)

               QUIT 0

 +10      ;

 +11       NEW I,IN1,RETV

 +12       SET RETV=0

 +13       FOR I=2:1

               SET IN1=$PIECE($GET(LIST),";",I)

               if IN1=""

                   QUIT

               SET RETV=$SELECT(IN1=INS:1,1:0)

               if RETV

                   QUIT

 +14       QUIT RETV

 +15      ;

COST(RX,FILL) ;

 +1       ; Calculate Drug Cost for RX/Fill

 +2       ; Input:

 +3       ;   RX:   Prescription IEN

 +4       ;   FILL: Fill Number

 +5       ; Output:

 +6       ;   Drug Cost

 +7       ;

 +8        IF '$GET(RX)

               QUIT ""

 +9        IF $GET(FILL)=""

               QUIT ""

 +10      ;

 +11       NEW DATA,COST,QTY

 +12       IF FILL=0

               SET COST=$$FILE^IBRXUTL(RX,17,"I")

               SET QTY=$$FILE^IBRXUTL(RX,7,"I")

 +13       IF FILL

               SET COST=$$SUBFILE^IBRXUTL(RX,FILL,"",1.2,"I")

               SET QTY=$$SUBFILE^IBRXUTL(RX,FILL,"",1,"I")

 +14       QUIT COST*QTY

 +15      ;

 +16      ;Get VA DRUG CLASS pointer

 +17      ;

 +18      ; Input Variables: BP50 - ptr to DRUG (#50)

 +19      ;

 +20      ; Return Value -> n = ptr to VA DRUG CLASS (#50.605)

 +21      ;                 0 = Unknown

 +22      ;

GETDRGCL(BP50)  QUIT $$DRUGDIE(BP50,25)

 +1       ;

IBNCPEV3.m