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

BOPSD.m

Go to the documentation of this file. 
  1. BOPSD ;ILC/IHS/ALG/CIA/PLS - ILC Starter Dose Query ;19-Sep-2006 22:08;SM;
  1.  ;;1.0;AUTOMATED DISPENSING INTERFACE;**1**;Jul 26, 2005
  1.  ;
  1.  Q:'PSGP  Q:'PSGORD
  1.  N BOPJ,BOPDFN,BOPWHO,BOPI,BOPMID,BOPORDN,BOPDD0,BOPMED,BOPK,BOPN
  1.  N DA,DR,DIE,STA
  1.  S BOPDFN=PSGP,BOPORDN=+PSGORD
  1.  S BOPWHO=$$INTFACE^BOPTU(1) S BOPWHO=$S(BOPWHO="O":"Omnicell",1:"Pyxis")
  1.  F BOPI=0:0 S BOPI=$O(^PS(55,BOPDFN,5,BOPORDN,1,BOPI)) Q:'BOPI  D
  1.  .S BOPDD0=$G(^PS(55,BOPDFN,5,BOPORDN,1,BOPI,0)) Q:'BOPDD0
  1.  .Q:$P(BOPDD0,U,3)  ; Check for inactive date
  1.  .S STA=$P(^PS(55,BOPDFN,5,BOPORDN,0),U,9)
  1.  .Q:STA'="A"&(STA'="R")&(STA'="RE")
  1.  .S BOPMID=+$P(BOPDD0,U) Q:'$D(^PSDRUG(BOPMID,0))
  1.  .Q:'$D(^BOP(90355.2,"AT",BOPDFN,BOPMID))  ;No entries for medication or already linked
  1. ASK .S BOPK=0
  1.  .W !!,"The following items were removed from a "_$G(BOPWHO)_" Medstation."
  1.  .W !,?5,"BOPED DRUG",?46,"QUANTITY",?61,"DATE/TIME",!
  1.  .K BOPMED
  1.  .F BOPJ=0:0 S BOPJ=$O(^BOP(90355.2,"AT",BOPDFN,BOPMID,BOPJ)) Q:BOPJ<1  D
  1.  ..Q:'$D(^BOP(90355.2,BOPJ,0))
  1.  ..S BOPK=BOPK+1,BOPMED(BOPK)=BOPJ
  1.  ..W !,BOPK,?5,$P(^PSDRUG(BOPMID,0),U)
  1.  ..W ?50,$P(^BOP(90355.2,BOPJ,0),U,5)
  1.  ..W ?56,$$FMTE^XLFDT($P($G(^BOP(90355.2,BOPJ,0)),U,3),"2Z"),!  ;S Y=$P(^BOP(90355.2,BOPJ,0),U,3) X ^DD("DD") W ?56,Y,!
  1.  .Q:'BOPK  ; No entries to link
  1.  .S DIR("A")="If any of the above is a pre-exchange dose for this order, select its number."
  1.  .S DIR(0)="N" D ^DIR K DIR Q:$D(DIRUT)
  1.  .S BOPN=+Y I '$D(BOPMED(BOPN)) W $C(7) G ASK
  1.  .D UPXTRA(BOPDFN,BOPORDN,BOPI,BOPMED(BOPN))
  1.  .S DA=BOPMED(BOPN)
  1.  .S DIE="^BOP(90355.2,",DR=".04///"_BOPORDN_";.07///@"_";.08///R"
  1.  .D ^DIE
  1.  Q
  1.  ;
  1.  ; Update Extra Units field
  1. UPXTRA(DFN,UORDN,MSEQN,RECDRGI) ;
  1.  N DA,DIE,DR
  1.  S DA=MSEQN,DA(1)=UORDN,DA(2)=DFN
  1.  S DIE="^PS(55,"_DFN_",5,"_UORDN_",1,"
  1.  S DR=".11///"_$P(^BOP(90355.2,RECDRGI,0),U,5)
  1.  S:$P($G(^PS(55,DFN,5,UORDN,1,MSEQN,0)),"^",11) $P(^(0),"^",11)=""
  1.  D ^DIE
  1.  Q
  1.  ; Return linked unit dose order number
  1.  ; Input:
  1.  ;         DFN - Patient
  1.  ;         MEDIEN - Drug IEN
  1.  ; Output: Order Number (e.g. 30-1478) or null ("")
  1.  N RES,DA,NODE
  1.  S RES=""
  1.  S DA=0 F  S DA=$O(^BOP(90355.2,"C",DFN,DA)) Q:'DA  D  Q:RES
  1.  .S NODE=^BOP(90355.2,DA,0)
  1.  .Q:+NODE'=MEDIEN  ; compare medication
  1.  .Q:'$P(NODE,U,4)  ; lacks an order number
  1.  .Q:'$$ISACTIVE(DFN,+$P(NODE,U,4),MEDIEN)
  1.  .S RES=$P(NODE,U,4)  ; return order number
  1.  Q RES
  1.  ; Return true if unit dose order med is active
  1.  ; Input: DFN - Patient
  1.  ;        ORDNUM - Unit Dose order number
  1.  ;        MEDIEN - Drug IEN
  1.  ; Output: Boolean
  1. ISACTIVE(DFN,ORDNUM,MEDIEN) ; EP
  1.  N LP,SEQN,NODE,STA
  1.  S (SEQN,LP)=0 F  S LP=$O(^PS(55,DFN,5,ORDNUM,1,"B",MEDIEN,LP)) Q:'LP  D
  1.  .S NODE=^PS(55,DFN,5,ORDNUM,1,LP,0)
  1.  .Q:$P(NODE,U,3)   ; med is inactive
  1.  .S STA=$P(^PS(55,DFN,5,ORDNUM,0),U,9)
  1.  .I STA="A"!(STA="R")!(STA="RE") D  ;Active, Renewed and Reinstated
  1.  ..S SEQN=LP
  1.  Q ''SEQN
  1.  ; Find entries matching patient and med and not matched to inpatient order
  1. FINDITMS(DFN,MEDIEN,ARY) ;EP
  1.  N LP,DA
  1.  K ARY
  1.  S DA=0 F  S DA=$O(^BOP(90355.2,"C",DFN,DA)) Q:'DA  D
  1.  .S NODE=^BOP(90355.2,DA,0)
  1.  .Q:+NODE'=MEDIEN  ; compare medication
  1.  .Q:$P(NODE,U,4)   ; can't have order number
  1.  .S ARY(DA)=NODE
  1.  Q
  1.  ; Combine similiar entries into first entry matching patient and med.
  1. COMBINE(DA,ARY) ;EP
  1.  Q:'DA
  1.  N IEN,QTY
  1.  S QTY=$P(^BOP(90355.2,DA,0),U,5)
  1.  S IEN=DA F  S IEN=$O(ARY(IEN)) Q:'IEN  D
  1.  .S QTY=QTY+$P(ARY(IEN),U,5)
  1.  .D DELITM(IEN)
  1.  D UPDITM(DA,QTY)
  1.  Q
  1.  ; Delete combined entry
  1. DELITM(DA) ;EP
  1.  N DIK
  1.  S DIK="^BOP(90355.2,"
  1.  D ^DIK
  1.  Q
  1.  ; Update Qty value of entry
  1. UPDITM(DA,QTY) ;EP
  1.  N ERR
  1.  S FDA(90355.2,DA_",",.05)=QTY
  1.  D FILE^DIE("K","FDA","ERR")
  1.  Q