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