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

BEHORXCV.m

Go to the documentation of this file. 
  1. BEHORXCV ;MSC/IND/PLS/DKM - Cover Sheet: Medications ;09-Jan-2014 13:59;DU
  1.  ;;1.1;BEH COMPONENTS;**033002,033003,033004,033005**;Mar 20, 2007
  1.  ;=================================================================
  1.  ; List medications
  1.  ; IHS/MSC/MGH reconcillation data added 1/09/2014
  1. LIST(DATA,DFN) ;EP
  1.  N RXN,CNT,X,Y,Z
  1.  S DATA=$$TMPGBL^CIAVMRPC,CNT=0
  1.  K ^TMP("PS",$J)
  1.  D OCL^PSOORRL(DFN,"","")
  1.  F RXN=0:0 S RXN=$O(^TMP("PS",$J,RXN)) Q:'RXN  S X=^(RXN,0) D
  1.  .S:$P($P(X,U),";",2)="I" $P(X,U,15)=$P($G(^OR(100,+$P(X,U,8),0)),U,7)
  1.  .D ADD(X)
  1.  K ^TMP("PS",$J)
  1.  F RXN=0:0 S RXN=$O(^AUPNVMED("AC",DFN,RXN)) Q:'RXN  D
  1.  .S X=$G(^AUPNVMED(RXN,0)),Z=$G(^(11)),Y=$G(^AUPNVSIT(+$P(X,U,3),0))
  1.  .Q:$P(Y,U,7)'="E"   ; Historical visits only
  1.  .Q:$L($P(Z,U,2))    ; No associated rx
  1.  .Q:$L($P(Z,U,8))        ; Outside meds already in meds list - P7
  1.  .D ADD(RXN_";E^"_$$GET1^DIQ(50,+X,.01)_"^^^^^^^"_$S($P(X,U,8):"DISCONTINUED",1:"ACTIVE")_"*^^^^^^"_(Y\1))
  1.  Q
  1.  ; List medication detail
  1. DETAIL(DATA,DFN,ID) ;EP
  1.  N I,X,Y,NODE,RXN,PROV,DRUG,INPT,CNT
  1.  S DATA=$$TMPGBL^CIAVMRPC,CNT=0
  1.  I $P(ID,";",2)="E" D VMED Q
  1.  D OEL^PSOORRL(DFN,ID)
  1.  S NODE=$G(^TMP("PS",$J,0)),RXN=$G(^("RXN",0)),PROV=$G(^TMP("PS",$J,"P",0)),DRUG=$P(NODE,U),INPT=$P(ID,";",2)="I"
  1.  I $P($G(^OR(100,+$P(NODE,U,11),0)),U,11)=$O(^ORD(100.98,"B","IV RX",0)) D
  1.  .D IV
  1.  E  D DRUG
  1.  ; Add start & stop dates, status
  1.  D ADD()
  1.  D:$P(RXN,U,5) ADD($P($G(^VA(200,+$P(RXN,U,5),0)),U),"Pharmacist:")
  1.  D ADD($$FMTE^XLFDT($P(NODE,U,5),"2P"),"Start Date:")
  1.  D ADD($$FMTE^XLFDT($P(NODE,U,3),"2P"),"Stop Date:")
  1.  D ADD($P(NODE,U,6),"Status:")
  1.  D:$P(NODE,U,11) ADD("Order #"_+$P(NODE,U,11))
  1.  D ADD($$GETRXNRM^BEHORXFN(+$P(NODE,U,11)),"RXNorm Code:")
  1.  D RECON(+$P(NODE,U,11),"M")
  1.  K ^TMP("PS",$J)
  1.  Q
  1.  ; VMED Detail
  1. VMED S NODE=$G(^AUPNVMED(+ID,0)),X=+$P(NODE,U,3)
  1.  D ADD($$GET1^DIQ(50,+NODE,.01)),ADD()
  1.  D ADD("Outside","Prescription #:")
  1.  D ADD($P(NODE,U,7),"Days Supply:")
  1.  D ADD($P(NODE,U,6),"Quantity:")
  1.  D ADD($P(NODE,U,5),"Sig:")
  1.  D ADD($$FMTE^XLFDT($G(^AUPNVSIT(X,0))\1,2),"Prescribed:")
  1.  D:$P(NODE,U,8) ADD($$FMTE^XLFDT($P(NODE,U,8),2),"Discontinued:")
  1.  D ADD($P($G(^AUPNVSIT(X,21)),U),"Where Dispensed:")
  1.  Q
  1.  ; Drug Detail
  1. DRUG D ADD(DRUG),ADD()
  1.  D:RXN ADD($P(RXN,U),"Prescription #:")
  1.  D:PROV ADD($P(PROV,U,2),"Prescriber:")
  1.  D ADD($P(NODE,U,9),"Total Dose:")
  1.  D ADD($P(NODE,U,10),"Units/Dose:")
  1.  D MULT("MDR","Route:")
  1.  D MULT("SCH","Schedule:")
  1.  D WP("SIG",$S(INPT:"Instructions:",1:"Sig:"))
  1.  D WP("PC","Provider Comments:")
  1.  D WP("SIO","Other Instructions:")
  1.  D ADD()
  1.  I 'INPT D
  1.  .D ADD($P(NODE,U,7),"Days Supply:")
  1.  .D ADD($P(NODE,U,8),"Quantity:")
  1.  .D:$P(NODE,U,12) ADD($$FMTE^XLFDT($P(NODE,U,12),2),"Last Filled:")
  1.  .D ADD($P(NODE,U,4),"Refills Remaining:")
  1.  .I $P(RXN,U,6)!$G(^TMP("PS",$J,"REF",0)) D
  1.  ..S I=0,X="Filled:"
  1.  ..D:$P(RXN,U,6) FILLED("R",$P(RXN,U,6)_"^^^"_$P(RXN,U,7)_U_$P(RXN,U,3,4),.X)
  1.  ..F  S I=$O(^TMP("PS",$J,"REF",I)) Q:'I  D FILLED("R",$G(^(I,0)),.X)
  1.  .I $G(^TMP("PS",$J,"PAR",0)) D
  1.  ..S I=0,X="Partial Fills:"
  1.  ..F  S I=$O(^TMP("PS",$J,"PAR",I)) Q:'I  D FILLED("P",$G(^(I,0)),.X)
  1.  I INPT,$D(^TMP("PS",$J,"ADM")) D
  1.  .S X="Admin Times:",I=0
  1.  .F  S I=$O(^TMP("PS",$J,"ADM",I)) Q:I'>0  S Y=$G(^(I,0)) D:$L(Y) ADD(Y,.X)
  1.  Q
  1.  ; IV Fluid Detail
  1. IV D ADD("IV Fluid"),ADD()
  1.  D:PROV ADD($P(PROV,U,2),"Prescriber:")
  1.  D MULT("B","Solution:")
  1.  D MULT("A","Additive:")
  1.  D ADD($P(NODE,U,2),"Infusion Rate:")
  1.  D WP("PC","Provider Comments:")
  1.  Q
  1.  ; Add WP item
  1. WP(SUB,CAPTION) ;
  1.  N LP,DIWL,DIWR,DIWF,X
  1.  S DIWL=1,DIWR=60,DIWF="C60",LP=0
  1.  K ^UTILITY($J,"W")
  1.  F  S LP=+$O(^TMP("PS",$J,SUB,LP)) Q:'LP  S X=^(LP,0) D ^DIWP
  1.  F  S LP=+$O(^UTILITY($J,"W",DIWL,LP)) Q:'LP  D ADD(^(LP,0),.CAPTION)
  1.  K ^UTILITY($J,"W")
  1.  Q
  1.  ; Add multi-valued item
  1. MULT(SUB,CAPTION) ;
  1.  N I
  1.  S I=0
  1.  F  S I=$O(^TMP("PS",$J,SUB,I)) Q:'I  D ADD($TR(^(I,0),U," "),.CAPTION)
  1.  Q
  1.  ; Add FILLD data
  1. FILLED(TYPE,FILLD,CAPTION) ;
  1.  N Y
  1.  S Y=$$FMTE^XLFDT($P(FILLD,U),2)_" ("_$$ROUTING($P(FILLD,U,5))_")"
  1.  S:TYPE="R"&$P(FILLD,U,4) Y=Y_" released "_$$FMTE^XLFDT($P(FILLD,U,4),2)
  1.  S:TYPE="P"&$P(FILLD,U,3) Y=Y_" Qty: "_$P(FILLD,U,3)
  1.  D ADD(Y,.CAPTION)
  1.  D:$L($P(FILLD,U,6)) ADD($P(FILLD,U,6),"")
  1.  Q
  1.  ; Return routing info
  1. ROUTING(X) ;
  1.  Q $S($G(X)="":"",X="M":"Mail",X="W":"Window",1:X)
  1.  ; Add to output array
  1. ADD(TXT,LBL) ;
  1.  S TXT=$G(TXT," ")
  1.  S:$L(TXT) CNT=CNT+1,@DATA@(CNT)=$S($D(LBL):$$LJ^XLFSTR(LBL,20),1:"")_TXT,LBL=""
  1.  Q
  1. RECON(RX,TYP) ;Get reconciliation data
  1.  N REC,IEN,AIEN,WHEN,BY
  1.  Q:RX=""
  1.  S REC=""
  1.  S REC=$O(^BEHOCIR("G",TYP,RX,REC),-1) Q:REC=""  D
  1.  .S IEN="" S IEN=$O(^BEHOCIR("G",TYP,RX,REC,IEN),-1) Q:IEN=""  D
  1.  ..S AIEN=IEN_","_REC_","
  1.  ..S WHEN=$$GET1^DIQ(90461.632,AIEN,.01)
  1.  ..S BY=$$GET1^DIQ(90461.632,AIEN,.02)
  1.  ..D ADD("Reconciled On: "_WHEN_" by "_BY)
  1.  Q