PSBZVSD ;IHS/MSC/MGH - BCMA RPCS ;24-Mar-2014 23:48;DU
;;3.0;BAR CODE MED ADMIN;**1017**;Mar 2004;Build 40
;Search virtual due list to see why the scanned in med was not found in it
;Search is first for VA Generic drug, then STRENGTH and then ROUTE
;Return message on what was not found
;Inp= TYPE ^ IEN -type is DD,SOL,ADD, or ID
; List= List of IENs on VDL for that same page
;Ret=-1^text ^header ^ .01 of IEN
EN(DATA,DRGIEN,DFN,LIST) ;EP-
S DATA(0)=1
S DATA(1)="-1^Invalid Medication Lookup"
Q:$G(DUZ("AG"))'="I"
N DMATCH,SMATCH,RMATCH,DNAME,VANAME
S RET="",(DMATCH,SMATCH,RMATCH)=0
S DRGIEN=$$FIND1^DIC(50,"","AX",DRGIEN,"B^C") ;Allows lookup by Drug IEN or Synonym
Q:'DRGIEN
S DNAME=$$GET1^DIQ(50,DRGIEN,.01)
S VANAME=$$GET1^DIQ(50,DRGIEN,20)
D DISP(DRGIEN,VANAME,.LIST)
Q
DISP(DRG,VANAME,LIST) ;EP-
N CDRG,NAME,IEN,GIEN,TYPE,IEN
S CDRG="" F S CDRG=$O(LIST(CDRG)) Q:CDRG="" D
.S IEN=$G(LIST(CDRG))
.S TYPE=$P($G(LIST(CDRG)),U,1)
.S IEN=$P($G(LIST(CDRG)),U,2)
.Q:'+IEN
.S GIEN=$S(TYPE="SOL":$$GET1^DIQ(52.7,IEN,1,"I"),TYPE="ADD":$$GET1^DIQ(52.6,IEN,1,"I"),TYPE="DD":IEN,1:"")
.S NAME=$$GET1^DIQ(50,GIEN,20)
.I NAME=VANAME S DMATCH=1 D ROUTE(DRG,GIEN)
I DMATCH=0&(SMATCH=0)&(RMATCH=0) S DATA(1)="-1^Scanned Drug Not Found in Virtual Due List^Wrong Drug ^"_DNAME Q
I DMATCH=1&(RMATCH=0)&(SMATCH=0) S DATA(1)="-1^Scanned Drug dose does not match route ordered^Wrong Route ^"_DNAME Q
I DMATCH=1&(RMATCH=1)&(SMATCH=0) S DATA(1)="-1^Scanned Drug does not match dose ordered^Wrong Dose ^"_DNAME Q
I DMATCH=1&(RMATCH=1)&(SMATCH=1) S DATA(1)="-1^Idential match is not found.Please use Unable to Scan option ^Not Identical ^"_DNAME
Q
STRENGTH(DRG,GIEN) ;EP -see if the strength matches
N VASTR,DRSTR1
S VASTR=$$GET1^DIQ(50,DRG,901)
S DRSTR=$$GET1^DIQ(50,GIEN,901)
I VASTR=""&(DRSTR="") D
.S VASTR=$$GET1^DIQ(50,DRG,21,"I")
.S DRSTR=$$GET1^DIQ(50,GIEN,21,"I")
I VASTR=DRSTR S SMATCH=1
Q
ROUTE(DRG,GIEN) ;EP- See if the route matches
N VAROU,DRROU,POI,POI2
S POI=$$GET1^DIQ(50,DRG,2.1,"I")
S POI2=$$GET1^DIQ(50,GIEN,2.1,"I")
S VAROU=$$GET1^DIQ(50.7,POI,.06)
S DRROU=$$GET1^DIQ(50.7,POI2,.06)
I VAROU=DRROU S RMATCH=1 D STRENGTH(DRG,GIEN)
Q
;For IV barcodes, check that the patient matches
;If pt matches then find the bag number in file 55
;If its there, compare it to items on the VDL
;Inp= CNT from calling program
; STRING= Scanned barcode
; TAB = BCMA tab (PBTAB,IVTAB)
IVCHK(DATA,CNT,STRING,TAB,DFN) ;EP- Check for IV bag barcode match
I STRING["V"!(STRING["W") D
.I DFN'="" D
..I DFN=+STRING D CHKIV Q
..I DFN'=+STRING S DATA(CNT)="-1^Scanned drug does not match patient^Wrong Patient"
E I STRING?.N D
.D:$G(DFN) CHKDRG
Q
;
CHKDRG ;EP-
N SLIST,ALIST,SOL,ADD,DD,ERR,CNT,IEN,ERRTXT,ERRTXT2,NAME
S ERR=0,CNT=0
K LIST
S NAME=$$GET1^DIQ(50,STRING,.01)
D GETLST(.SLIST,.ALIST)
S INP=STRING
S SOL=0 F S SOL=$O(SLIST(SOL)) Q:SOL="" D
.S IEN=$G(SLIST(SOL))
.I IEN'="" D
..S DD=$P($G(^PS(52.7,IEN,0)),U,2)
..S CNT=CNT+1
..S LIST(CNT)="DD^"_DD
S ADD=0 F S ADD=$O(ALIST(ADD)) Q:ADD="" D
.S IEN=$G(ALIST(ADD))
.I IEN'="" D
..S DD=$P($G(^PS(52.6,IEN,0)),U,2)
..S CNT=CNT+1
..S LIST(CNT)="DD^"_DD
D EN(.ERR,INP,DFN,.LIST)
Q
CHKIV ;EP- Find the item in pts list
N IEN,BAG,DONE,LIST,ADDIEN,SOLIEN,SLIST,ALIST,RETURN,ERR
S DONE=0,DATA="",ERR=0
S IEN=0 F S IEN=$O(^PS(55,DFN,"IVBCMA",IEN)) Q:IEN=""!(DONE=1) D
.S BAG=$P($G(^PS(55,DFN,"IVBCMA",IEN,0)),U,1)
.I BAG=STRING D
..S DONE=1
..D GETLST(.SLIST,.ALIST)
..S SOL=0 F S SOL=$O(^PS(55,DFN,"IVBCMA",IEN,"SOL",SOL)) Q:SOL=""!(ERR=1) D
...S SOLIEN=$P($G(^PS(55,DFN,"IVBCMA",IEN,"SOL",SOL,0)),U,1)
...S INP="SOL^"_SOLIEN
...D EN(.RETURN,INP,DFN,.SLIST)
...I $D(RETURN(1)) S ERR=1,DATA(CNT)=RETURN(1)
..Q:ERR=1
..S ADD=0 F S ADD=$O(^PS(55,DFN,"IVBCMA",IEN,"AD",ADD)) Q:ADD=""!(ERR=1) D
...S ADDIEN=$P($G(^PS(55,DFN,"IVBCMA",IEN,"AD",ADD,0)),U,1)
...S INP="ADD^"_ADDIEN
...D EN(.RETURN,INP,DFN,.ALIST)
...I $D(RETURN(1)) S ERR=1,DATA(CNT)=RETURN(1)
I DONE=0 S DATA(CNT)="-1^Drug Not Found in Virtual Due List^Wrong Drug"
Q
GETLST(SLIST,ALIST) ;EP- Get list of solutions and additives
N SIEN,AIEN,RESULTS,NODE,CNT2
S CNT2=1
K ^TMP("PSB",$J)
D RPC^PSBVDLTB(.RESULTS,DFN,TAB)
S NUM=$G(@RESULTS@(0))
F I=2:1:NUM D
.S NODE=$G(@RESULTS@(I))
.I $P(NODE,U,1)="SOL" S SLIST(CNT2)=$P(NODE,U,2)
.I $P(NODE,U,1)="ADD" S ALIST(CNT2)=$P(NODE,U,2)
.I $P(NODE,U,1)="END" S CNT2=CNT2+1
Q
PSBZVSD ;IHS/MSC/MGH - BCMA RPCS ;24-Mar-2014 23:48;DU
+1 ;;3.0;BAR CODE MED ADMIN;**1017**;Mar 2004;Build 40
+2 ;Search virtual due list to see why the scanned in med was not found in it
+3 ;Search is first for VA Generic drug, then STRENGTH and then ROUTE
+4 ;Return message on what was not found
+5 ;Inp= TYPE ^ IEN -type is DD,SOL,ADD, or ID
+6 ; List= List of IENs on VDL for that same page
+7 ;Ret=-1^text ^header ^ .01 of IEN
EN(DATA,DRGIEN,DFN,LIST) ;EP-
+1 SET DATA(0)=1
+2 SET DATA(1)="-1^Invalid Medication Lookup"
+3 IF $GET(DUZ("AG"))'="I"
QUIT
+4 NEW DMATCH,SMATCH,RMATCH,DNAME,VANAME
+5 SET RET=""
SET (DMATCH,SMATCH,RMATCH)=0
+6 ;Allows lookup by Drug IEN or Synonym
SET DRGIEN=$$FIND1^DIC(50,"","AX",DRGIEN,"B^C")
+7 IF 'DRGIEN
QUIT
+8 SET DNAME=$$GET1^DIQ(50,DRGIEN,.01)
+9 SET VANAME=$$GET1^DIQ(50,DRGIEN,20)
+10 DO DISP(DRGIEN,VANAME,.LIST)
+11 QUIT
DISP(DRG,VANAME,LIST) ;EP-
+1 NEW CDRG,NAME,IEN,GIEN,TYPE,IEN
+2 SET CDRG=""
FOR
SET CDRG=$ORDER(LIST(CDRG))
IF CDRG=""
QUIT
Begin DoDot:1
+3 SET IEN=$GET(LIST(CDRG))
+4 SET TYPE=$PIECE($GET(LIST(CDRG)),U,1)
+5 SET IEN=$PIECE($GET(LIST(CDRG)),U,2)
+6 IF '+IEN
QUIT
+7 SET GIEN=$SELECT(TYPE="SOL":$$GET1^DIQ(52.7,IEN,1,"I"),TYPE="ADD":$$GET1^DIQ(52.6,IEN,1,"I"),TYPE="DD":IEN,1:"")
+8 SET NAME=$$GET1^DIQ(50,GIEN,20)
+9 IF NAME=VANAME
SET DMATCH=1
DO ROUTE(DRG,GIEN)
End DoDot:1
+10 IF DMATCH=0&(SMATCH=0)&(RMATCH=0)
SET DATA(1)="-1^Scanned Drug Not Found in Virtual Due List^Wrong Drug ^"_DNAME
QUIT
+11 IF DMATCH=1&(RMATCH=0)&(SMATCH=0)
SET DATA(1)="-1^Scanned Drug dose does not match route ordered^Wrong Route ^"_DNAME
QUIT
+12 IF DMATCH=1&(RMATCH=1)&(SMATCH=0)
SET DATA(1)="-1^Scanned Drug does not match dose ordered^Wrong Dose ^"_DNAME
QUIT
+13 IF DMATCH=1&(RMATCH=1)&(SMATCH=1)
SET DATA(1)="-1^Idential match is not found.Please use Unable to Scan option ^Not Identical ^"_DNAME
+14 QUIT
STRENGTH(DRG,GIEN) ;EP -see if the strength matches
+1 NEW VASTR,DRSTR1
+2 SET VASTR=$$GET1^DIQ(50,DRG,901)
+3 SET DRSTR=$$GET1^DIQ(50,GIEN,901)
+4 IF VASTR=""&(DRSTR="")
Begin DoDot:1
+5 SET VASTR=$$GET1^DIQ(50,DRG,21,"I")
+6 SET DRSTR=$$GET1^DIQ(50,GIEN,21,"I")
End DoDot:1
+7 IF VASTR=DRSTR
SET SMATCH=1
+8 QUIT
ROUTE(DRG,GIEN) ;EP- See if the route matches
+1 NEW VAROU,DRROU,POI,POI2
+2 SET POI=$$GET1^DIQ(50,DRG,2.1,"I")
+3 SET POI2=$$GET1^DIQ(50,GIEN,2.1,"I")
+4 SET VAROU=$$GET1^DIQ(50.7,POI,.06)
+5 SET DRROU=$$GET1^DIQ(50.7,POI2,.06)
+6 IF VAROU=DRROU
SET RMATCH=1
DO STRENGTH(DRG,GIEN)
+7 QUIT
+8 ;For IV barcodes, check that the patient matches
+9 ;If pt matches then find the bag number in file 55
+10 ;If its there, compare it to items on the VDL
+11 ;Inp= CNT from calling program
+12 ; STRING= Scanned barcode
+13 ; TAB = BCMA tab (PBTAB,IVTAB)
IVCHK(DATA,CNT,STRING,TAB,DFN) ;EP- Check for IV bag barcode match
+1 IF STRING["V"!(STRING["W")
Begin DoDot:1
+2 IF DFN'=""
Begin DoDot:2
+3 IF DFN=+STRING
DO CHKIV
QUIT
+4 IF DFN'=+STRING
SET DATA(CNT)="-1^Scanned drug does not match patient^Wrong Patient"
End DoDot:2
End DoDot:1
+5 IF '$TEST
IF STRING?.N
Begin DoDot:1
+6 IF $GET(DFN)
DO CHKDRG
End DoDot:1
+7 QUIT
+8 ;
CHKDRG ;EP-
+1 NEW SLIST,ALIST,SOL,ADD,DD,ERR,CNT,IEN,ERRTXT,ERRTXT2,NAME
+2 SET ERR=0
SET CNT=0
+3 KILL LIST
+4 SET NAME=$$GET1^DIQ(50,STRING,.01)
+5 DO GETLST(.SLIST,.ALIST)
+6 SET INP=STRING
+7 SET SOL=0
FOR
SET SOL=$ORDER(SLIST(SOL))
IF SOL=""
QUIT
Begin DoDot:1
+8 SET IEN=$GET(SLIST(SOL))
+9 IF IEN'=""
Begin DoDot:2
+10 SET DD=$PIECE($GET(^PS(52.7,IEN,0)),U,2)
+11 SET CNT=CNT+1
+12 SET LIST(CNT)="DD^"_DD
End DoDot:2
End DoDot:1
+13 SET ADD=0
FOR
SET ADD=$ORDER(ALIST(ADD))
IF ADD=""
QUIT
Begin DoDot:1
+14 SET IEN=$GET(ALIST(ADD))
+15 IF IEN'=""
Begin DoDot:2
+16 SET DD=$PIECE($GET(^PS(52.6,IEN,0)),U,2)
+17 SET CNT=CNT+1
+18 SET LIST(CNT)="DD^"_DD
End DoDot:2
End DoDot:1
+19 DO EN(.ERR,INP,DFN,.LIST)
+20 QUIT
CHKIV ;EP- Find the item in pts list
+1 NEW IEN,BAG,DONE,LIST,ADDIEN,SOLIEN,SLIST,ALIST,RETURN,ERR
+2 SET DONE=0
SET DATA=""
SET ERR=0
+3 SET IEN=0
FOR
SET IEN=$ORDER(^PS(55,DFN,"IVBCMA",IEN))
IF IEN=""!(DONE=1)
QUIT
Begin DoDot:1
+4 SET BAG=$PIECE($GET(^PS(55,DFN,"IVBCMA",IEN,0)),U,1)
+5 IF BAG=STRING
Begin DoDot:2
+6 SET DONE=1
+7 DO GETLST(.SLIST,.ALIST)
+8 SET SOL=0
FOR
SET SOL=$ORDER(^PS(55,DFN,"IVBCMA",IEN,"SOL",SOL))
IF SOL=""!(ERR=1)
QUIT
Begin DoDot:3
+9 SET SOLIEN=$PIECE($GET(^PS(55,DFN,"IVBCMA",IEN,"SOL",SOL,0)),U,1)
+10 SET INP="SOL^"_SOLIEN
+11 DO EN(.RETURN,INP,DFN,.SLIST)
+12 IF $DATA(RETURN(1))
SET ERR=1
SET DATA(CNT)=RETURN(1)
End DoDot:3
+13 IF ERR=1
QUIT
+14 SET ADD=0
FOR
SET ADD=$ORDER(^PS(55,DFN,"IVBCMA",IEN,"AD",ADD))
IF ADD=""!(ERR=1)
QUIT
Begin DoDot:3
+15 SET ADDIEN=$PIECE($GET(^PS(55,DFN,"IVBCMA",IEN,"AD",ADD,0)),U,1)
+16 SET INP="ADD^"_ADDIEN
+17 DO EN(.RETURN,INP,DFN,.ALIST)
+18 IF $DATA(RETURN(1))
SET ERR=1
SET DATA(CNT)=RETURN(1)
End DoDot:3
End DoDot:2
End DoDot:1
+19 IF DONE=0
SET DATA(CNT)="-1^Drug Not Found in Virtual Due List^Wrong Drug"
+20 QUIT
GETLST(SLIST,ALIST) ;EP- Get list of solutions and additives
+1 NEW SIEN,AIEN,RESULTS,NODE,CNT2
+2 SET CNT2=1
+3 KILL ^TMP("PSB",$JOB)
+4 DO RPC^PSBVDLTB(.RESULTS,DFN,TAB)
+5 SET NUM=$GET(@RESULTS@(0))
+6 FOR I=2:1:NUM
Begin DoDot:1
+7 SET NODE=$GET(@RESULTS@(I))
+8 IF $PIECE(NODE,U,1)="SOL"
SET SLIST(CNT2)=$PIECE(NODE,U,2)
+9 IF $PIECE(NODE,U,1)="ADD"
SET ALIST(CNT2)=$PIECE(NODE,U,2)
+10 IF $PIECE(NODE,U,1)="END"
SET CNT2=CNT2+1
End DoDot:1
+11 QUIT
