Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSBZVSD

PSBZVSD.m

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