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

BOPROC.m

Go to the documentation of this file. 
  1. BOPROC ; ILC/IHS/ALG - Process FT1 statments;14-Nov-2006 10:45;SM;
  1.  ;;1.0;AUTOMATED DISPENSING INTERFACE;**1,2**;Jul 26, 2005
  1.  Q
  1. DFT(BOPI) ;EP -  This is the entry point to process the FT1/DFT messages
  1.  ; BOPI = IEN for file 90355.1  (BOP QUEUE File)
  1.  ;
  1.  N INPAT,A,B,C,BOMS,BOPORDT,BOPDTA,BOPDT,BOPDRGI,BOPVDT
  1.  ;IHS/MSC/PLS - 10/24/06 - Next line commented out for patch 2
  1.  ;Q:$$VENDTYP()'="P"  ;Only Pyxis devices orders are supported in patch 1
  1.  S (BOPTT,BOPTC,BOPMSU,BOPPRDN,BOPDT,BOPMID,BOPSITE)=""
  1.  S (BOPTYP,BOPAMID,BOPDFN,BOPTQ,BOPTQA,BOPOB,BOPNU)=""
  1.  S (OPMSUN,BOPPYNM,BOPNAME)=""
  1.  S BOPSITE=+$P(^BOP(90355.1,BOPI,0),U,12)  ;Set to Receiving Facility
  1.  S BOPSITE=+$P($G(^BOP(90355,1,3,BOPSITE,0)),U,9)  ;Set to Outpatient Site (File 59)
  1.  Q:'BOPSITE
  1.  S BOPJ=0 K BOPARY
  1. ONE ;
  1.  S BOPJ=$O(BOPIN(BOPJ)) I BOPJ="" D:$G(BOPARY(2))'="" LOOP G DONE
  1.  S X=BOPIN(BOPJ)
  1.  I X?1"MSH".E S BOMS=BOPJ G ONE
  1.  I X?1"EVN".E G ONE
  1.  ; collect one group
  1.  I X?1"PID".E D  D:$G(BOPARY(2))'="" LOOP S BOPJ=BOPJ-1 G ONE
  1.  .K BOPARY S BOPARY=1,BOPARY(1)=X
  1.  . F  S OUT=0,K=BOPJ,BOPJ=$O(BOPIN(BOPJ)) D  Q:OUT  I 'BOPJ S BOPJ=K+1 Q
  1.  ..I 'BOPJ D  Q
  1.  ...I 'BOMS Q
  1.  ...; evn is before pid
  1.  ...N I,X F I=BOMS:1:K S X=$G(BOPIN(I)) I X?1"EVN".E S BOPARY(4)=X Q
  1.  ...K I,X Q
  1.  ..S X=$G(BOPIN(BOPJ))
  1.  ..I X?1"PID".E S OUT=1 Q
  1.  ..I X?1"PV1".E S F=BOPARY,F=F+1,BOPARY=F,BOPARY(F)=X Q
  1.  ..I X?1"FT1".E S F=BOPARY,F=F+1,BOPARY=F,BOPARY(F)=X Q
  1.  ..I X?1"EVN".E S BOPARY(4)=X Q
  1.  ..S OUT=1 Q
  1.  ; process BOPARY
  1. LOOP S (A,B,C,BOMS)=0
  1. L1 ;
  1.  S A=$O(BOPARY(A)) I 'A K BOPARY Q
  1.  S X=$G(BOPARY(A))
  1.  I X?1"PID".E S BOPPID=X G L1
  1.  I X?1"PV1".E S BOPPV1=X G L1
  1.  I X?1"EVN".E S BOPEVN=X G L1
  1.  I X?1"FT1".E S BOPFT1=X
  1.  I $G(BOPEVN)="" S BOPEVN=$G(BOPARY(4))
  1.  ; above is for the possibilty of multiple FT1's for a pt. PID and PV1
  1.  ; stay the same but FT1 can change
  1. RUN ; first check if supply or drug
  1.  S BOPUSER="" S BOPUSER=$P(BOPPID,"|",21) S BOPUSER=$P(BOPUSER,"^",3)_" "_$P(BOPUSER,"^",2)
  1.  S BOPDFN="" S BOPDFN=$P(BOPPID,"|",4) I BOPDFN="" D LOGEXN(5) G L1
  1.  I '$D(^DPT(BOPDFN,0)) D LOGEXN(6) G L1
  1.  ; Determine patient status
  1.  S INPAT=$$ISINPT(BOPDFN)
  1.  S BOPDRGI=$$DRGIEN(BOPFT1)
  1.  I BOPDRGI="" D LOGEXN(3) G L1
  1.  S X=BOPFT1,BOPDB=$E($P(X,"|",18),1),BOPDB=$TR(BOPDB,"ds","DS")
  1.  ; Check to see if item is in BOP DRUG file
  1.  S BOPDREC=$O(^BOP(90355.5,"BOP",BOPDRGI,""))
  1.  ; If drug not in BOP DRUG file, process as Supply Item
  1.  I BOPDREC=""!INPAT G SUPFILE
  1.  S BOPCRCH=$$TRANTYP(BOPFT1)
  1.  ; Process Credit transaction
  1.  I BOPCRCH="CR" D  G L1
  1.  .N PSONOOR,%APSITE,%APSITE2,%APSITE3,APSDRTDA,BOPPSRX
  1.  .S BOPPSRX=""
  1.  .S %APSITE=$G(^APSPCTRL(BOPSITE,0))
  1.  .S %APSITE2=$G(^APSPCTRL(BOPSITE,2))
  1.  .S %APSITE3=$G(^APSPCTRL(BOPSITE,3))
  1.  .S BOPPSRX=$O(^BOP(90355.44,"DRUG",BOPDFN,BOPDRGI,BOPPSRX),-1)
  1.  .; A prescription was found, now mark as deleted.
  1.  .I BOPPSRX D
  1.  ..N PSOIB,DA,RX,RXN,DIK,PSOABCDA,PSOZVER,DFN,I,STAT,COM,PSONOOR
  1.  ..S PSONOOR="S"  ; Set Nature of Order to Service Correction
  1.  ..S PSOZVER=1  ; Control flag used by PSORXDL. Setting to 1 allows inventory adjustment and POS call to be made.
  1.  ..; Set prescription status to DELETED
  1.  ..S DA=BOPPSRX D ENQ^PSORXDL
  1.  ; Process Charge transaction on drug/create NON-VERIFIED prescription
  1.  I BOPDB["D" D  D:BOPDAS ENTRY^BOPUVER(BOPDAS)
  1.  .S BOPDT=$$NOW^XLFDT
  1.  .N DIC K DO,DD S DIC="^BOP(90355.44,",DIC(0)="L",X=BOPDT D FILE^DICN
  1.  .S BOPDAS=+Y,D=$G(^BOP(90355.44,BOPDAS,0))
  1.  .S E=BOPDB_U_BOPI_U_$P(BOPPID,"|",4)_U_$P(BOPPID,"|",19)_U S:$P(BOPPID,"|",20) E=E_$P(BOPPID,"|",20)
  1.  .S $P(^BOP(90355.44,BOPDAS,0),U,2,6)=E
  1.  .F I=1:1:3 S ^BOP(90355.44,BOPDAS,I)=$S(I=1:BOPPID,I=2:BOPPV1,I=3:BOPFT1,1:"")
  1.  .N DA,DIK S DA=BOPDAS,DIK="^BOP(90355.44," D IX1^DIK K DA,DIK
  1.  .S ^BOP(90355.1,BOPI,"TRACE4")=BOPDAS_U_$P(BOPPID,"|",4)_U_BOPDRGI
  1.  G L1 ; if drug in 90355.5 file, create unverified drug, but don't put it into ihs hl7 supply file
  1.  ;
  1. SUPFILE ; Set item into IHS HL7 Supply Interface file
  1.  ; supply file only - don't create unverified order
  1.  S BOPNAME=$P(BOPPID,"|",6)
  1.  ;S BOPDFN=$P(BOPPID,"|",4)
  1.  S BOPEXFN=$P(BOPPID,"|",19)
  1.  S BOPSSN=$P(BOPPID,"|",20)
  1. IHSHRN I 'BOPDFN D    ; Lookup up using HRN if in record
  1.  .Q:'BOPEXFN  ;alternate ID not available
  1.  .N A,B,D,E,F,G
  1.  .S (A,B,D,E,F,G)=""
  1.  .S (A,B)="^AUPNPAT(""D"","_BOPEXFN S A=A_")"
  1.  .I BOPEXFN?1N.N D  ; make sure that it is a number
  1.  ..S D="" F  S A=$Q(@A) Q:A=""!($E(A,1,$L(B))'=B)  D  Q:D'=""
  1.  ...S E=$P(A,",",3),F=$P($P(A,",",4),")",1)
  1.  ...S G=$G(^AUPNPAT(E,0)) Q:G=""
  1.  ...S G=$G(^DPT(E,0)) Q:G=""
  1.  ...S D=E
  1.  .S BOPDFN=D
  1.  S BOPLOC=$P($P(BOPPV1,"|",4),U)   ; assigned patient location
  1.  S BOPATDOC=$P(BOPPV1,"|",8)       ; attending doc
  1.  S BOPDESC=$S($$VENDTYP()="O":$P(BOPFT1,"|",9),$$VENDTYP()="P":$P($P(BOPFT1,"|",8),U,2))        ; charge description
  1.  S BOPDT=$P(BOPFT1,"|",5)          ; HL7 transaction dt/time
  1.  S BOPTT=$$TRANTYP(BOPFT1)  ;$P(BOPFT1,"|",7)          ; transaction type CHarge or CRedit
  1.  S BOPTC=$P($P(BOPFT1,"|",8),U)          ; transaction code  (charge id)
  1.  S BOPTQ=$P(BOPFT1,"|",11)         ; transaction qty
  1.  S BOPTQA=$S(BOPTT["CR":(BOPTQ*-1),1:BOPTQ)
  1.  S BOPMSU=$P(BOPFT1,"|",14)        ; code for station used map to ^BOP(90355.41)
  1.  S BOPOB=$P(BOPFT1,"|",22),BOPOB=$P(BOPOB,U,2)_","_$TR($P(BOPOB,U,3,4),U," ")    ; ordered by
  1.  I BOPOB]"" S BOPOB=$O(^VA(200,"B",BOPOB,0))
  1.  S BOPORDN=$$ORDNUM(BOPFT1)       ; order number.  nn-nnn pt order nnnn just item
  1.  I 'BOPORDN D  ;Check for previously linked dispenses
  1.  .S BOPORDN=$$GETLINK^BOPSD(BOPDFN,BOPDRGI)
  1.  ;
  1. CHK ; chk point
  1.  ; basic check
  1.  S BOP3PCM="",BOP3PPRC=""
  1.  S BOPPRICE="",BOPDRUG=""
  1.  I 'BOPDFN D LOGEXN(5) G L1
  1.  I '$D(^DPT(BOPDFN,0)) D LOGEXN(6) G L1
  1.  I BOPDESC="" D LOGEXN(4) G L1
  1.  S BOPDTA=$$FMDATE^HLFNC(BOPDT),(BOPVDT,BOPORDT)=BOPDTA
  1.  ; check for visit date from ^AUPNVSIT("AC"
  1.  S X="zzzzzz",BOPAUVST=""
  1.  F  S X=$O(^AUPNVSIT("AC",BOPDFN,X),-1) Q:'X  S OUT="" D  Q:OUT=1  ; get most recent
  1.  .S B=$G(^AUPNVSIT(X,0)) Q:B=""  ; no data
  1.  .S B=$P(B,U,1) Q:B=""  ; no date
  1.  .I B=BOPDTA!(B<BOPDTA) S BOPORDT=B,BOPAUVST=X,OUT=1 Q
  1.  I BOPORDT=BOPDTA&(BOPAUVST="")&(+BOPORDN) D  ; chk for order dt in 55 if not visit
  1.  .S G=+$P($G(^PS(55,BOPDFN,5,+BOPORDN,0)),U,14)
  1.  .S:G BOPORDT=G
  1.  ;
  1.  ; Add dispense record to IHS HL7 Supply File
  1.  N DIC K DO,DD S DIC="^AUPNSUP(",DIC(0)="L",X=BOPDESC D FILE^DICN
  1.  I '$P(Y,U,3) D LOGEXN(7) G L1
  1.  S BOPAUDA=+Y
  1.  S X=BOPDFN_U_BOPORDT_U_U_BOPDTA
  1.  S $P(^AUPNSUP(BOPAUDA,0),U,2,5)=X
  1.  I BOPDB="D" D
  1.  .S ^AUPNSUP(BOPAUDA,1)=$$GET1^DIQ(50,+BOPTC,31)_"^^"_BOPTC  ;NDC^^Drug IEN
  1.  E  D
  1.  .S ^AUPNSUP(BOPAUDA,1)=BOPTC  ; Supply Code
  1.  S ^AUPNSUP(BOPAUDA,2)=BOPDESC_U_BOPORDT_U_BOPTQA
  1.  ;
  1.  I BOPDB="S" D  ;-> if supply get chg code price
  1.  .S BOP3PCM=$O(^ABMCM("D",BOPTC,BOP3PCM))
  1.  .I $G(BOP3PCM) S BOP3PPRC=$P($G(^ABMDFEE(1,32,BOP3PCM,0)),U,2)
  1.  .S $P(^AUPNSUP(BOPAUDA,2),U,4)=BOP3PPRC
  1.  I BOPDB="D" D  ;-> if drug get price from psdrug
  1.  .S $P(^AUPNSUP(BOPAUDA,2),U,4)=$$GDRGPRC($$DRGIEN(BOPFT1),1)
  1.  ;
  1.  N DA,DIK S DA=BOPAUDA,DIK="^AUPNSUP(" D IX1^DIK K DA,DIK ; do xreff
  1.  ;
  1.  ; put BOPAUVST into 90355.1 node TRK by BOPJ, BOPDFN, BOPAUVST
  1.  ; BOPJ is the current FT1 node being worked on
  1.  ;
  1.  S X=$G(^BOP(90355.1,BOPI,0)) I X'="" S ^BOP(90355.1,BOPI,"TRK",(BOPJ+0),BOPDFN,(BOPAUVST+0))=$G(BOPAUDA)
  1.  ; Update Extra Units for inpatient med order
  1.  I BOPDB="D",INPAT,+BOPORDN D
  1.  .D ADDXTRA
  1.  ; Add inpatient dispense to BOP RECEIVE DRUG file
  1.  I BOPDB="D",INPAT D
  1.  .D ADDRECDG(BOPDRGI,BOPDFN,BOPVDT,BOPORDN,BOPTQA,+BOPOB,"S","")
  1.  .;D ADDRECDG(BOPDRGI,BOPDFN,BOPORDT,BOPORDN,BOPTQA,+BOPOB,"S","")
  1.  G L1
  1.  ;
  1. DONE Q
  1.  ; Return Inpatient status
  1. ISINPT(DFN) ;EP
  1.  N VAIN,VAERR
  1.  D INP^VADPT
  1.  Q +$G(VAIN(1))
  1.  ;
  1.  ; Update Dispense Drug Extra Units Dispensed
  1. ADDXTRA ; EP
  1.  Q:'BOPDFN!'BOPORDN!'BOPDRGI
  1.  N FDA,DIEN,MSG
  1.  S DIEN=$O(^PS(55,BOPDFN,5,+BOPORDN,1,"B",BOPDRGI,0))
  1.  Q:'DIEN
  1.  S IENS=DIEN_","_+BOPORDN_","_BOPDFN_","
  1.  S FDA(55.07,IENS,.11)=BOPTQA
  1.  D FILE^DIE("K","FDA","MSG")
  1.  Q
  1.  ; Return drug price
  1. GDRGPRC(DIEN,AWPFLG) ; EP
  1.  Q:'DIEN ""
  1.  S AWPFLG=$G(AWPFLG,0)
  1.  N BOPPRICE
  1.  S BOPPRICE=""
  1.  S:AWPFLG BOPPRICE=$$GET1^DIQ(50,DIEN,9999999.32)
  1.  S:'BOPPRICE BOPPRICE=$$GET1^DIQ(50,DIEN,16)
  1.  Q BOPPRICE
  1.  ; Return Order Number for Inpatient Order
  1. ORDNUM(BOPFT1) ;EP
  1.  N RES,VEND
  1.  S VEND=$$VENDTYP()
  1.  I VEND="O" D     ; Process Omnicell Message
  1.  .S RES=+$P(BOPFT1,"|",24)
  1.  E  I VEND="P" D  ; Process Pyxis Message
  1.  .S RES=+$P(BOPFT1,"|",10)
  1.  Q RES
  1.  ; Return DRUG IEN
  1. DRGIEN(BOPFT1) ;EP
  1.  N RES,VEND
  1.  S VEND=$$VENDTYP()
  1.  ;I VEND="O" D   ; Process Omnicell message
  1.  ;.S RES=$P(BOPFT1,"|",24)  ; Filler Order Number (Order Number-Drug IEN)
  1.  ;.S RES=$P(RES,"-",$L(RES,"-"))  ; Last piece contains Drug IEN
  1.  ;E  I VEND="P" D  ; Process Pyxis message
  1.  S RES=+$P($P(BOPFT1,"|",8),U)  ; Format=Drug IEN^Description or NDC^Description
  1.  Q $G(RES)
  1.  ; Return Vendor type (internal format)
  1. VENDTYP() ;EP
  1.  Q $$GET1^DIQ(90355,1,2.5,"I")
  1.  ; Return CHarge or CRedit for Transaction Type
  1. TRANTYP(BOPFT1) ;EP
  1.  N RES,VEND
  1.  S VEND=$$VENDTYP()
  1.  S RES=$P(BOPFT1,"|",7)
  1.  I VEND="P" D  ; Process Pyxis message
  1.  .S RES=$S(RES["V":"CH",1:"CR")
  1.  Q RES
  1.  ; Add entry to BOP RECEIVE DRUG file
  1. ADDRECDG(DRUG,PAT,VDATE,ORDNUM,QVEND,ORDBY,ORDTYP,DISNAM) ;
  1.  N MSG,FDA,IEN,ARY
  1.  S IENS="+1,"
  1.  ; Combine quantity of extraneous entries
  1.  I '$G(ORDNUM) D
  1.  .D FINDITMS^BOPSD(PAT,DRUG,.ARY)
  1.  .S IEN=$O(ARY(0))
  1.  .Q:'IEN
  1.  .D COMBINE^BOPSD(IEN,.ARY)
  1.  .S IENS=IEN_","
  1.  .S QVEND=QVEND+$P(^BOP(90355.2,IEN,0),U,5)
  1.  Q:'$G(DRUG)
  1.  S FDA(90355.2,IENS,.01)=DRUG
  1.  S FDA(90355.2,IENS,.02)=$G(PAT)
  1.  S FDA(90355.2,IENS,.03)=$G(VDATE)
  1.  S:$G(ORDNUM) FDA(90355.2,IENS,.04)=+ORDNUM
  1.  S FDA(90355.2,IENS,.05)=$G(QVEND)
  1.  S:$G(ORDBY) FDA(90355.2,IENS,.06)=ORDBY
  1.  S:'$G(ORDNUM)&($G(ORDTYP)="S") FDA(90355.2,IENS,.07)=$G(ORDTYP)
  1.  S FDA(90355.2,IENS,.09)=BOPI
  1.  S FDA(90355.2,IENS,.1)=$G(DISNAM)
  1.  S:$G(ORDNUM) FDA(90355.2,IENS,.08)="R"
  1.  D UPDATE^DIE(,"FDA",,"MSG")
  1.  Q
  1.  ; Add exception to log
  1. LOGEXN(BOPERR) ; EP
  1.  N FDA,FN,MSG,IENS
  1.  S FN=90355.4,IENS="+1,"
  1.  S FDA(FN,IENS,.01)=$$NOW^XLFDT
  1.  S FDA(FN,IENS,.02)=$G(BOPDFN)
  1.  S FDA(FN,IENS,.03)=$G(BOPORDT)
  1.  S FDA(FN,IENS,.04)=$G(BOPORDN)
  1.  S FDA(FN,IENS,.05)=$G(BOPTQA)
  1.  ;S FDA(FN,IENS,.06)=  ;ORDERED BY
  1.  ;S FDA(FN,IENS,.07)=  ;ORDER TYPE ( PREPAK, OBS, STARTER DOSE, NORMAL OR SUPPLY)
  1.  S FDA(FN,IENS,.08)=$G(BOPORDN)
  1.  ;S FDA(FN,IENS,.1)=  ;ITEM NAME
  1.  S FDA(FN,IENS,.09)=BOPERR
  1.  S FDA(FN,IENS,.11)=$G(BOPDRGI)
  1.  ;S FDA(FN,IENS,.12)=  ;CHARGE DESCRIPTION
  1.  S FDA(FN,IENS,.13)=$G(BOPI)  ;QUEUE IEN
  1.  D UPDATE^DIE(,"FDA",,"MSG")
  1.  Q