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 Dec 13, 2024@02:25 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 ;
