ORQ21 ; SLC/MKB/GSS - Detailed Order Report cont ;13-Mar-2014 16:39;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,190,1005,1007,195,215,243,1010,1011,1012,1013**;Dec 17, 1997;Build 242
;
; DBIA 2400 OEL^PSOORRL ^TMP("PS",$J)
; DBIA 2266 EN30^RAO7PC1 ^TMP($J,"RAE2")
; Modified - IHS/MSC/PLS - 03/15/2011 - Line M2+10
; 04/15/2013 - Line ACTLOG+19
; 06/05/2013 - Line M2+13
; 09/11/2013 - Line MED+3
; 03/12/2014 - New SSDSIG,SSDNTP EPs
RAD(TCOM) ; -- add RA data for 2.5 orders
N RAIFN,CASE,PROC,ORD,ORI,X,ORTTL,ORB
S RAIFN=$G(^OR(100,ORIFN,4)) Q:RAIFN'>0
D EN30^RAO7PC1(RAIFN) Q:'$D(^TMP($J,"RAE2",+ORVP)) ;DBIA 2266
S ORD=$G(^TMP($J,"RAE2",+ORVP,"ORD")),CASE=$O(^(0)) Q:'CASE S PROC=$O(^(CASE,""))
I '$G(TCOM) D ;else add only Tech Comments
. S CNT=CNT+1,@ORY@(CNT)=$$LJ^XLFSTR("Procedure:",30)_$S($L(ORD):ORD,1:PROC)
. S ORI=0,ORTTL="Procedure Modifiers: ",ORB=1
. F S ORI=$O(^TMP($J,"RAE2",+ORVP,CASE,PROC,"M",ORI)) Q:ORI'>0 S CNT=CNT+1,@ORY@(CNT)=ORTTL_^(ORI),ORTTL=$$REPEAT^XLFSTR(" ",30)
. S CNT=CNT+1,@ORY@(CNT)="History and Reason for Exam:"
. F S ORI=$O(^TMP($J,"RAE2",+ORVP,CASE,PROC,"H",ORI)) Q:ORI'>0 S CNT=CNT+1,@ORY@(CNT)=" "_^(ORI)
RAD1 I $L($G(^TMP($J,"RAE2",+ORVP,CASE,PROC,"TCOM",1))) S X=^(1) D
. N DIWL,DIWR,DIWF,I K ^UTILITY($J,"W")
. S DIWL=1,DIWR=72,DIWF="C72" D ^DIWP
. S CNT=CNT+1,@ORY@(CNT)="Technologist's Comment:",ORB=1
. S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=" "_^(I,0)
I $D(^TMP($J,"RAE2",+ORVP,CASE,PROC,"CM")) D
. S ORTTL="Contrast Media used: ",ORI=0,ORB=1
. F S ORI=$O(^TMP($J,"RAE2",+ORVP,CASE,PROC,"CM",ORI)) Q:ORI<1 S CNT=CNT+1,@ORY@(CNT)=ORTTL_$P(^(ORI),U,2),ORTTL=$$REPEAT^XLFSTR(" ",30)
K ^TMP($J,"RAE2",+ORVP),^UTILITY($J,"W")
S:$G(ORB) CNT=CNT+1,@ORY@(CNT)=" " ;blank
Q
;
MED ; -- Add Pharmacy order data
Q:$G(^OR(100,ORIFN,4))["N" ;non-VA med -- no refill history
D SSDSIG($$VALUE^ORCSAVE2(+ORIFN,"SSRREQIEN")) ;IHS/MSC/PLS - 03/12/2014
D SSDNTP($$VALUE^ORCSAVE2(+ORIFN,"SSRREQIEN")) ;IHS/MSC/PLS - 03/12/2014
N TYPE,NODE,RXN,OR5,STAT S TYPE=$P(OR0,U,12)
I TYPE="O",$G(^OR(100,ORIFN,4))["V" S TYPE="I" ;IHS/MSC/PLS - 09/11/2013 Fix for Outpatient IV Orders
I '$D(^TMP("PS",$J,0)) D ;get PS data / DBIA 2400
. N PSIFN S PSIFN=$G(^OR(100,ORIFN,4))
. S:TYPE="O" PSIFN=$TR(PSIFN,"S","P")_$S(PSIFN?1.N:"R",1:"")
. D OEL^PSOORRL(+ORVP,PSIFN_";"_TYPE) ;DBIA 2400
S NODE=$G(^TMP("PS",$J,0)),RXN=$G(^("RXN",0)),STAT=$P(NODE,U,6)
I '$L(NODE) K ^TMP("PS",$J) Q ;error
I $O(^TMP("PS",$J,"DD",0)) D ;Disp Drugs
. N I,X,Y S X="Dispense Drugs (units/dose): ",I=0
. F S I=$O(^TMP("PS",$J,"DD",I)) Q:I'>0 S Y=$G(^(I,0)) S:Y CNT=CNT+1,@ORY@(CNT)=X_$$GET1^DIQ(50,+Y_",",.01)_" ("_$P(Y,U,2)_")"
S:$P(NODE,U,9) CNT=CNT+1,@ORY@(CNT)="Total Dose: "_$P(NODE,U,9)
M1 I TYPE="I" D ;admin data
. N I,X,Y I $O(^TMP("PS",$J,"B",0)) D
.. S X="IV Print Name: ",I=0
.. F S I=$O(^TMP("PS",$J,"B",I)) Q:I<1 S Y=$G(^(I,0)) S:$L(Y) CNT=CNT+1,@ORY@(CNT)=X_$P(Y,U),X=$$REPEAT^XLFSTR(" ",30) I $L($P(Y,U,3)) S CNT=CNT+1,@ORY@(CNT)=X_" "_$P(Y,U,3)
. S I=+$O(^TMP("PS",$J,"SCH",0)),X=$P($G(^(I,0)),U,2)
. S:$L(X) CNT=CNT+1,@ORY@(CNT)="Schedule Type: "_X
. S X="Administration Times: ",I=0
. F S I=$O(^TMP("PS",$J,"ADM",I)) Q:I'>0 S Y=$G(^(I,0)) S:$L(Y) CNT=CNT+1,@ORY@(CNT)=X_Y,X=$$REPEAT^XLFSTR(" ",30)
M2 I TYPE="O" D ;fill history
. N FILLD,RET,X,Y,I
. S:$P(NODE,U,12) CNT=CNT+1,@ORY@(CNT)="Last Filled: "_$$FMTE^XLFDT($P(NODE,U,12),2)
. S CNT=CNT+1,@ORY@(CNT)="Refills Remaining: "_$P(NODE,U,4)
. I $P(RXN,U,6)!$G(^TMP("PS",$J,"REF",0)) S X="Filled: " D
.. I $P(RXN,U,6) S FILLD=$P(RXN,U,6)_"^^^"_$P(RXN,U,7)_U_$P(RXN,U,3,4) D FILLED("R")
.. S RET=$G(^TMP("PS",$J,"RXN","RSTC")) I RET'="" D RETURNS(RET)
.. S I=0 F S I=$O(^TMP("PS",$J,"REF",I)) Q:I'>0 D
... S FILLD=$G(^(I,0)) D FILLED("R")
... S RET=$G(^TMP("PS",$J,"REF",I,"RSTC")) I RET'="" D RETURNS(RET)
. I $G(^TMP("PS",$J,"PAR",0)) S I=0,X="Partial Fills: " F S I=$O(^TMP("PS",$J,"PAR",I)) Q:I'>0 S FILLD=$G(^(I,0)) D FILLED("P")
. S:RXN CNT=CNT+1,@ORY@(CNT)="Prescription#: "_$P(RXN,U)
.S:$L($$GETRXNRM^BEHORXFN(+ORIFN)) CNT=CNT+1,@ORY@(CNT)="RXNorm Code: "_$$GETRXNRM^BEHORXFN(+ORIFN)
.S CNT=CNT+1,@ORY@(CNT)="Discharge Medication: "_$$EXTERNAL^DILFD(52,9999999.28,,$$VALUE^ORCSAVE2(ORIFN,"DSCMED")) ;IHS/MSC/PLS - 06/05/13
M3 S:$P(RXN,U,5) CNT=CNT+1,@ORY@(CNT)="Pharmacist: "_$P($G(^VA(200,+$P(RXN,U,5),0)),U)
I $G(STAT)="ACTIVE/SUSP" S CNT=CNT+1,@ORY@(CNT)="Prescription Status: "_STAT_" - Order is active. Fill or Refill has been requested."
D ACTLOG($G(^OR(100,ORIFN,4))) ;IHS/MSC/PLS - Display activity log
S:$P(NODE,U,13) CNT=CNT+1,@ORY@(CNT)="NOT TO BE GIVEN" K ^TMP("PS",$J)
S CNT=CNT+1,@ORY@(CNT)=" " ;blank
S OR5=$G(^OR(100,ORIFN,5)) I $L(OR5) D ;SC data
. N X,Y,I
. S CNT=CNT+1,@ORY@(CNT)=" " ;blank line
. S CNT=CNT+1,@ORY@(CNT)="First Party Pay Exemptions"
. S X="For conditions related to: "
. F I=1:1:8 S Y=$P(OR5,U,I) I Y S CNT=CNT+1,@ORY@(CNT)=X_$$SC(I),X=$$REPEAT^XLFSTR(" ",30)
Q
;
BA ;Billing Aware data display
N DXIEN,DXV,ICD9,ICDR,OCT,ORFMDAT
S OCT=0,X=""
; Get the date of the order for CSV/CTD usage
S ORFMDAT=$$ORFMDAT^ORWDBA3(ORIFN)
; $O through diagnoses for an order
F S OCT=$O(^OR(100,ORIFN,5.1,OCT)) Q:OCT'?1N.N D
. ; DXIEN=Dx IEN
. S DXIEN=+^OR(100,ORIFN,5.1,OCT,0)
. ; Get Dx record for date ORFMDAT
. S ICDR=$$ICDDX^ICDCODE(DXIEN,ORFMDAT)
. ; Get Dx verbiage and ICD code
. S DXV=$P(ICDR,U,4),ICD9=$P(ICDR,U,2)
. S X=" "
. I OCT=1 D
.. S CNT=CNT+1,@ORY@(CNT)=" " ;blank line
.. S CNT=CNT+1,@ORY@(CNT)="Clinical Indicators"
.. S X="Diagnosis of: "
. S X=X_ICD9_" - "_DXV,CNT=CNT+1,@ORY@(CNT)=X
I OCT'="" D ;if there are diagnoses show Treatment Factors
. S X="For conditions related to: "
. F I=1:1:8 S Y=$P(^OR(100,ORIFN,5.2),U,I) I Y D
.. S CNT=CNT+1,@ORY@(CNT)=X_$$SC(I),X=$$REPEAT^XLFSTR(" ",30)
Q
;
FILLED(TYPE) ; -- add FILLD data
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)
S CNT=CNT+1,@ORY@(CNT)=X_Y,X=$$REPEAT^XLFSTR(" ",30)
S:$L($P(FILLD,U,6)) CNT=CNT+1,@ORY@(CNT)=X_$P(FILLD,U,6)
Q
RETURNS(NODE) ; add Return to Stock Data
N DATE,NAME,TEXT,X
S DATE=$$FMTE^XLFDT($P(NODE,U))
S NAME=$P(^VA(200,$P(NODE,U,2),0),U)
S X=$$REPEAT^XLFSTR(" ",13)
S TEXT="Return to Stock: "_X_DATE_" by "_NAME
S CNT=CNT+1,@ORY@(CNT)=TEXT
S X=$$REPEAT^XLFSTR(" ",30)
S TEXT=X_"Comments: "_$P(NODE,U,3)
S CNT=CNT+1,@ORY@(CNT)=TEXT
Q
;
ROUTING(X) ; -- Returns external form
N Y S Y=$S($G(X)="M":"Mail",$G(X)="W":"Window",1:$G(X))
Q Y
;
SC(J) ; -- Returns name of SC field by piece number
I '$G(J) Q ""
I J=1 Q "SERVICE CONNECTED CONDITION"
I J=2 Q "MILITARY SEXUAL TRAUMA"
I J=3 Q "AGENT ORANGE EXPOSURE"
I J=4 Q "IONIZING RADIATION EXPOSURE"
I J=5 Q "ENVIRONMENTAL CONTAMINANTS"
I J=6 Q "HEAD OR NECK CANCER"
I J=7 Q "COMBAT VETERAN"
I J=8 Q "SHIPBOARD HAZARD AND DEFENSE"
Q ""
; IHS/MSC/PLS - Display Dispense SIG in RXD
; Input: RREQ - IEN to APSP REFILL REQUEST File
SSDSIG(RREQ) ;EP-
Q:'$G(RREQ)!'$$TEST^CIAUOS("SSDSIG^APSPFNC1")
N DSIG
S DSIG=$$SSDSIG^APSPFNC1(RREQ)
I $L(DSIG) D
.S CNT=CNT+1
.S @ORY@(CNT)="Surescripts Dispense SIG for parent order("+$$GET1^DIQ(9009033.91,RREQ,".06:39.3")+"): "
.S CNT=CNT+1
.S @ORY@(CNT)=" "_DSIG
.S CNT=CNT+1
.S @ORY@(CNT)=" "
Q
; IHS/MSC/PLS - Display Surescripts Notes to Pharmacist in RXD
; Input: RREQ - IEN to APSP REFILL REQUEST File
SSDNTP(RREQ) ;EP-
Q:'$G(RREQ)!'$$TEST^CIAUOS("SSDNTP^APSPFNC1")
N DNTP
S DNTP=$$SSDNTP^APSPFNC1(RREQ)
I $L(DNTP) D
.S CNT=CNT+1
.S @ORY@(CNT)="Surescripts Dispense Notes to Prescriber for parent order("+$$GET1^DIQ(9009033.91,RREQ,".06:39.3")+"): "
.S CNT=CNT+1
.S @ORY@(CNT)=" "_DNTP
.S CNT=CNT+1
.S @ORY@(CNT)=" "
Q
; IHS/MSC/PLS - Display activity log in order detail
ACTLOG(RX) ;EP
Q:'$G(RX)
;Q:'$$GET1^DIQ(52,RX,9999999.23,"I") ; Only display activity log for autofinished prescriptions
N ACTD,ALP,AD,COM,BRK
D ACTLOG^APSPFNC1(.ACTD,RX)
I $D(ACTD) D
.S CNT=CNT+1
.S @ORY@(CNT)=" "
.S CNT=CNT+1
.S @ORY@(CNT)="Activity Log"
.S CNT=CNT+1
.S @ORY@(CNT)="# Date Reason Rx Ref Initiator Of Activity"
.S CNT=CNT+1
.S $P(@ORY@(CNT),"=",79)="="
.S ALP=0 F S ALP=$O(ACTD(ALP)) Q:'ALP D
..S AD=ACTD(ALP),IENS=$P(AD,U)_","_RX_","
..S COM=$P(AD,U,6)
..S CNT=CNT+1
..S @ORY@(CNT)=$P(AD,U)_" "_$P($$FMTE^XLFDT($P(AD,U,2),"2Z"),"@")_" "_$$LJ^XLFSTR($$GET1^DIQ(52.3,IENS,.02),15)_$$LJ^XLFSTR($$GET1^DIQ(52.3,IENS,.03),15)_$$GET1^DIQ(52.3,IENS,.03)
..I $L($P(AD,U,7))!($L($P(AD,U,8))) D
...S CNT=CNT+1
...S @ORY@(CNT)=$$LJ^XLFSTR("Device: "_$P(AD,U,7),50)_" Type: "_$$GET1^DIQ(52.3,IENS,9999999.02)
..I $L(COM) D
...I $L(COM)<71 D
....S CNT=CNT+1
....S @ORY@(CNT)="Comments: "_COM
...E D
....I $E(COM,1,70)'[" " D
.....S CNT=CNT+1
.....S @ORY@(CNT)="Comments: "_$E(COM,1,70)
.....S CNT=CNT+1
.....S @ORY@(CNT)=$E(COM,71,245)
....E D
.....F BRK=245:-1 Q:BRK=0 I $E(COM,BRK)=" ",BRK<71 D Q
......S CNT=CNT+1
......S @ORY@(CNT)="Comments: "_$E(COM,1,BRK)
......S CNT=CNT+1
......S @ORY@(CNT)=$E(COM,BRK,245)
Q
ORQ21 ; SLC/MKB/GSS - Detailed Order Report cont ;13-Mar-2014 16:39;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,190,1005,1007,195,215,243,1010,1011,1012,1013**;Dec 17, 1997;Build 242
+2 ;
+3 ; DBIA 2400 OEL^PSOORRL ^TMP("PS",$J)
+4 ; DBIA 2266 EN30^RAO7PC1 ^TMP($J,"RAE2")
+5 ; Modified - IHS/MSC/PLS - 03/15/2011 - Line M2+10
+6 ; 04/15/2013 - Line ACTLOG+19
+7 ; 06/05/2013 - Line M2+13
+8 ; 09/11/2013 - Line MED+3
+9 ; 03/12/2014 - New SSDSIG,SSDNTP EPs
RAD(TCOM) ; -- add RA data for 2.5 orders
+1 NEW RAIFN,CASE,PROC,ORD,ORI,X,ORTTL,ORB
+2 SET RAIFN=$GET(^OR(100,ORIFN,4))
IF RAIFN'>0
QUIT
+3 ;DBIA 2266
DO EN30^RAO7PC1(RAIFN)
IF '$DATA(^TMP($JOB,"RAE2",+ORVP))
QUIT
+4 SET ORD=$GET(^TMP($JOB,"RAE2",+ORVP,"ORD"))
SET CASE=$ORDER(^(0))
IF 'CASE
QUIT
SET PROC=$ORDER(^(CASE,""))
+5 ;else add only Tech Comments
IF '$GET(TCOM)
Begin DoDot:1
+6 SET CNT=CNT+1
SET @ORY@(CNT)=$$LJ^XLFSTR("Procedure:",30)_$SELECT($LENGTH(ORD):ORD,1:PROC)
+7 SET ORI=0
SET ORTTL="Procedure Modifiers: "
SET ORB=1
+8 FOR
SET ORI=$ORDER(^TMP($JOB,"RAE2",+ORVP,CASE,PROC,"M",ORI))
IF ORI'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=ORTTL_^(ORI)
SET ORTTL=$$REPEAT^XLFSTR(" ",30)
+9 SET CNT=CNT+1
SET @ORY@(CNT)="History and Reason for Exam:"
+10 FOR
SET ORI=$ORDER(^TMP($JOB,"RAE2",+ORVP,CASE,PROC,"H",ORI))
IF ORI'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=" "_^(ORI)
End DoDot:1
RAD1 IF $LENGTH($GET(^TMP($JOB,"RAE2",+ORVP,CASE,PROC,"TCOM",1)))
SET X=^(1)
Begin DoDot:1
+1 NEW DIWL,DIWR,DIWF,I
KILL ^UTILITY($JOB,"W")
+2 SET DIWL=1
SET DIWR=72
SET DIWF="C72"
DO ^DIWP
+3 SET CNT=CNT+1
SET @ORY@(CNT)="Technologist's Comment:"
SET ORB=1
+4 SET I=0
FOR
SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
IF I'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=" "_^(I,0)
End DoDot:1
+5 IF $DATA(^TMP($JOB,"RAE2",+ORVP,CASE,PROC,"CM"))
Begin DoDot:1
+6 SET ORTTL="Contrast Media used: "
SET ORI=0
SET ORB=1
+7 FOR
SET ORI=$ORDER(^TMP($JOB,"RAE2",+ORVP,CASE,PROC,"CM",ORI))
IF ORI<1
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=ORTTL_$PIECE(^(ORI),U,2)
SET ORTTL=$$REPEAT^XLFSTR(" ",30)
End DoDot:1
+8 KILL ^TMP($JOB,"RAE2",+ORVP),^UTILITY($JOB,"W")
+9 ;blank
IF $GET(ORB)
SET CNT=CNT+1
SET @ORY@(CNT)=" "
+10 QUIT
+11 ;
MED ; -- Add Pharmacy order data
+1 ;non-VA med -- no refill history
IF $GET(^OR(100,ORIFN,4))["N"
QUIT
+2 ;IHS/MSC/PLS - 03/12/2014
DO SSDSIG($$VALUE^ORCSAVE2(+ORIFN,"SSRREQIEN"))
+3 ;IHS/MSC/PLS - 03/12/2014
DO SSDNTP($$VALUE^ORCSAVE2(+ORIFN,"SSRREQIEN"))
+4 NEW TYPE,NODE,RXN,OR5,STAT
SET TYPE=$PIECE(OR0,U,12)
+5 ;IHS/MSC/PLS - 09/11/2013 Fix for Outpatient IV Orders
IF TYPE="O"
IF $GET(^OR(100,ORIFN,4))["V"
SET TYPE="I"
+6 ;get PS data / DBIA 2400
IF '$DATA(^TMP("PS",$JOB,0))
Begin DoDot:1
+7 NEW PSIFN
SET PSIFN=$GET(^OR(100,ORIFN,4))
+8 IF TYPE="O"
SET PSIFN=$TRANSLATE(PSIFN,"S","P")_$SELECT(PSIFN?1.N:"R",1:"")
+9 ;DBIA 2400
DO OEL^PSOORRL(+ORVP,PSIFN_";"_TYPE)
End DoDot:1
+10 SET NODE=$GET(^TMP("PS",$JOB,0))
SET RXN=$GET(^("RXN",0))
SET STAT=$PIECE(NODE,U,6)
+11 ;error
IF '$LENGTH(NODE)
KILL ^TMP("PS",$JOB)
QUIT
+12 ;Disp Drugs
IF $ORDER(^TMP("PS",$JOB,"DD",0))
Begin DoDot:1
+13 NEW I,X,Y
SET X="Dispense Drugs (units/dose): "
SET I=0
+14 FOR
SET I=$ORDER(^TMP("PS",$JOB,"DD",I))
IF I'>0
QUIT
SET Y=$GET(^(I,0))
IF Y
SET CNT=CNT+1
SET @ORY@(CNT)=X_$$GET1^DIQ(50,+Y_",",.01)_" ("_$PIECE(Y,U,2)_")"
End DoDot:1
+15 IF $PIECE(NODE,U,9)
SET CNT=CNT+1
SET @ORY@(CNT)="Total Dose: "_$PIECE(NODE,U,9)
M1 ;admin data
IF TYPE="I"
Begin DoDot:1
+1 NEW I,X,Y
IF $ORDER(^TMP("PS",$JOB,"B",0))
Begin DoDot:2
+2 SET X="IV Print Name: "
SET I=0
+3 FOR
SET I=$ORDER(^TMP("PS",$JOB,"B",I))
IF I<1
QUIT
SET Y=$GET(^(I,0))
IF $LENGTH(Y)
SET CNT=CNT+1
SET @ORY@(CNT)=X_$PIECE(Y,U)
SET X=$$REPEAT^XLFSTR(" ",30)
IF $LENGTH($PIECE(Y,U,3))
SET CNT=CNT+1
SET @ORY@(CNT)=X_" "_$PIECE(Y,U,3)
End DoDot:2
+4 SET I=+$ORDER(^TMP("PS",$JOB,"SCH",0))
SET X=$PIECE($GET(^(I,0)),U,2)
+5 IF $LENGTH(X)
SET CNT=CNT+1
SET @ORY@(CNT)="Schedule Type: "_X
+6 SET X="Administration Times: "
SET I=0
+7 FOR
SET I=$ORDER(^TMP("PS",$JOB,"ADM",I))
IF I'>0
QUIT
SET Y=$GET(^(I,0))
IF $LENGTH(Y)
SET CNT=CNT+1
SET @ORY@(CNT)=X_Y
SET X=$$REPEAT^XLFSTR(" ",30)
End DoDot:1
M2 ;fill history
IF TYPE="O"
Begin DoDot:1
+1 NEW FILLD,RET,X,Y,I
+2 IF $PIECE(NODE,U,12)
SET CNT=CNT+1
SET @ORY@(CNT)="Last Filled: "_$$FMTE^XLFDT($PIECE(NODE,U,12),2)
+3 SET CNT=CNT+1
SET @ORY@(CNT)="Refills Remaining: "_$PIECE(NODE,U,4)
+4 IF $PIECE(RXN,U,6)!$GET(^TMP("PS",$JOB,"REF",0))
SET X="Filled: "
Begin DoDot:2
+5 IF $PIECE(RXN,U,6)
SET FILLD=$PIECE(RXN,U,6)_"^^^"_$PIECE(RXN,U,7)_U_$PIECE(RXN,U,3,4)
DO FILLED("R")
+6 SET RET=$GET(^TMP("PS",$JOB,"RXN","RSTC"))
IF RET'=""
DO RETURNS(RET)
+7 SET I=0
FOR
SET I=$ORDER(^TMP("PS",$JOB,"REF",I))
IF I'>0
QUIT
Begin DoDot:3
+8 SET FILLD=$GET(^(I,0))
DO FILLED("R")
+9 SET RET=$GET(^TMP("PS",$JOB,"REF",I,"RSTC"))
IF RET'=""
DO RETURNS(RET)
End DoDot:3
End DoDot:2
+10 IF $GET(^TMP("PS",$JOB,"PAR",0))
SET I=0
SET X="Partial Fills: "
FOR
SET I=$ORDER(^TMP("PS",$JOB,"PAR",I))
IF I'>0
QUIT
SET FILLD=$GET(^(I,0))
DO FILLED("P")
+11 IF RXN
SET CNT=CNT+1
SET @ORY@(CNT)="Prescription#: "_$PIECE(RXN,U)
+12 IF $LENGTH($$GETRXNRM^BEHORXFN(+ORIFN))
SET CNT=CNT+1
SET @ORY@(CNT)="RXNorm Code: "_$$GETRXNRM^BEHORXFN(+ORIFN)
+13 ;IHS/MSC/PLS - 06/05/13
SET CNT=CNT+1
SET @ORY@(CNT)="Discharge Medication: "_$$EXTERNAL^DILFD(52,9999999.28,,$$VALUE^ORCSAVE2(ORIFN,"DSCMED"))
End DoDot:1
M3 IF $PIECE(RXN,U,5)
SET CNT=CNT+1
SET @ORY@(CNT)="Pharmacist: "_$PIECE($GET(^VA(200,+$PIECE(RXN,U,5),0)),U)
+1 IF $GET(STAT)="ACTIVE/SUSP"
SET CNT=CNT+1
SET @ORY@(CNT)="Prescription Status: "_STAT_" - Order is active. Fill or Refill has been requested."
+2 ;IHS/MSC/PLS - Display activity log
DO ACTLOG($GET(^OR(100,ORIFN,4)))
+3 IF $PIECE(NODE,U,13)
SET CNT=CNT+1
SET @ORY@(CNT)="NOT TO BE GIVEN"
KILL ^TMP("PS",$JOB)
+4 ;blank
SET CNT=CNT+1
SET @ORY@(CNT)=" "
+5 ;SC data
SET OR5=$GET(^OR(100,ORIFN,5))
IF $LENGTH(OR5)
Begin DoDot:1
+6 NEW X,Y,I
+7 ;blank line
SET CNT=CNT+1
SET @ORY@(CNT)=" "
+8 SET CNT=CNT+1
SET @ORY@(CNT)="First Party Pay Exemptions"
+9 SET X="For conditions related to: "
+10 FOR I=1:1:8
SET Y=$PIECE(OR5,U,I)
IF Y
SET CNT=CNT+1
SET @ORY@(CNT)=X_$$SC(I)
SET X=$$REPEAT^XLFSTR(" ",30)
End DoDot:1
+11 QUIT
+12 ;
BA ;Billing Aware data display
+1 NEW DXIEN,DXV,ICD9,ICDR,OCT,ORFMDAT
+2 SET OCT=0
SET X=""
+3 ; Get the date of the order for CSV/CTD usage
+4 SET ORFMDAT=$$ORFMDAT^ORWDBA3(ORIFN)
+5 ; $O through diagnoses for an order
+6 FOR
SET OCT=$ORDER(^OR(100,ORIFN,5.1,OCT))
IF OCT'?1N.N
QUIT
Begin DoDot:1
+7 ; DXIEN=Dx IEN
+8 SET DXIEN=+^OR(100,ORIFN,5.1,OCT,0)
+9 ; Get Dx record for date ORFMDAT
+10 SET ICDR=$$ICDDX^ICDCODE(DXIEN,ORFMDAT)
+11 ; Get Dx verbiage and ICD code
+12 SET DXV=$PIECE(ICDR,U,4)
SET ICD9=$PIECE(ICDR,U,2)
+13 SET X=" "
+14 IF OCT=1
Begin DoDot:2
+15 ;blank line
SET CNT=CNT+1
SET @ORY@(CNT)=" "
+16 SET CNT=CNT+1
SET @ORY@(CNT)="Clinical Indicators"
+17 SET X="Diagnosis of: "
End DoDot:2
+18 SET X=X_ICD9_" - "_DXV
SET CNT=CNT+1
SET @ORY@(CNT)=X
End DoDot:1
+19 ;if there are diagnoses show Treatment Factors
IF OCT'=""
Begin DoDot:1
+20 SET X="For conditions related to: "
+21 FOR I=1:1:8
SET Y=$PIECE(^OR(100,ORIFN,5.2),U,I)
IF Y
Begin DoDot:2
+22 SET CNT=CNT+1
SET @ORY@(CNT)=X_$$SC(I)
SET X=$$REPEAT^XLFSTR(" ",30)
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
FILLED(TYPE) ; -- add FILLD data
+1 NEW Y
SET Y=$$FMTE^XLFDT($PIECE(FILLD,U),2)_" ("_$$ROUTING($PIECE(FILLD,U,5))_")"
+2 IF TYPE="R"&$PIECE(FILLD,U,4)
SET Y=Y_" released "_$$FMTE^XLFDT($PIECE(FILLD,U,4),2)
+3 IF TYPE="P"&$PIECE(FILLD,U,3)
SET Y=Y_" Qty: "_$PIECE(FILLD,U,3)
+4 SET CNT=CNT+1
SET @ORY@(CNT)=X_Y
SET X=$$REPEAT^XLFSTR(" ",30)
+5 IF $LENGTH($PIECE(FILLD,U,6))
SET CNT=CNT+1
SET @ORY@(CNT)=X_$PIECE(FILLD,U,6)
+6 QUIT
RETURNS(NODE) ; add Return to Stock Data
+1 NEW DATE,NAME,TEXT,X
+2 SET DATE=$$FMTE^XLFDT($PIECE(NODE,U))
+3 SET NAME=$PIECE(^VA(200,$PIECE(NODE,U,2),0),U)
+4 SET X=$$REPEAT^XLFSTR(" ",13)
+5 SET TEXT="Return to Stock: "_X_DATE_" by "_NAME
+6 SET CNT=CNT+1
SET @ORY@(CNT)=TEXT
+7 SET X=$$REPEAT^XLFSTR(" ",30)
+8 SET TEXT=X_"Comments: "_$PIECE(NODE,U,3)
+9 SET CNT=CNT+1
SET @ORY@(CNT)=TEXT
+10 QUIT
+11 ;
ROUTING(X) ; -- Returns external form
+1 NEW Y
SET Y=$SELECT($GET(X)="M":"Mail",$GET(X)="W":"Window",1:$GET(X))
+2 QUIT Y
+3 ;
SC(J) ; -- Returns name of SC field by piece number
+1 IF '$GET(J)
QUIT ""
+2 IF J=1
QUIT "SERVICE CONNECTED CONDITION"
+3 IF J=2
QUIT "MILITARY SEXUAL TRAUMA"
+4 IF J=3
QUIT "AGENT ORANGE EXPOSURE"
+5 IF J=4
QUIT "IONIZING RADIATION EXPOSURE"
+6 IF J=5
QUIT "ENVIRONMENTAL CONTAMINANTS"
+7 IF J=6
QUIT "HEAD OR NECK CANCER"
+8 IF J=7
QUIT "COMBAT VETERAN"
+9 IF J=8
QUIT "SHIPBOARD HAZARD AND DEFENSE"
+10 QUIT ""
+11 ; IHS/MSC/PLS - Display Dispense SIG in RXD
+12 ; Input: RREQ - IEN to APSP REFILL REQUEST File
SSDSIG(RREQ) ;EP-
+1 IF '$GET(RREQ)!'$$TEST^CIAUOS("SSDSIG^APSPFNC1")
QUIT
+2 NEW DSIG
+3 SET DSIG=$$SSDSIG^APSPFNC1(RREQ)
+4 IF $LENGTH(DSIG)
Begin DoDot:1
+5 SET CNT=CNT+1
+6 SET @ORY@(CNT)="Surescripts Dispense SIG for parent order("+$$GET1^DIQ(9009033.91,RREQ,".06:39.3")+"): "
+7 SET CNT=CNT+1
+8 SET @ORY@(CNT)=" "_DSIG
+9 SET CNT=CNT+1
+10 SET @ORY@(CNT)=" "
End DoDot:1
+11 QUIT
+12 ; IHS/MSC/PLS - Display Surescripts Notes to Pharmacist in RXD
+13 ; Input: RREQ - IEN to APSP REFILL REQUEST File
SSDNTP(RREQ) ;EP-
+1 IF '$GET(RREQ)!'$$TEST^CIAUOS("SSDNTP^APSPFNC1")
QUIT
+2 NEW DNTP
+3 SET DNTP=$$SSDNTP^APSPFNC1(RREQ)
+4 IF $LENGTH(DNTP)
Begin DoDot:1
+5 SET CNT=CNT+1
+6 SET @ORY@(CNT)="Surescripts Dispense Notes to Prescriber for parent order("+$$GET1^DIQ(9009033.91,RREQ,".06:39.3")+"): "
+7 SET CNT=CNT+1
+8 SET @ORY@(CNT)=" "_DNTP
+9 SET CNT=CNT+1
+10 SET @ORY@(CNT)=" "
End DoDot:1
+11 QUIT
+12 ; IHS/MSC/PLS - Display activity log in order detail
ACTLOG(RX) ;EP
+1 IF '$GET(RX)
QUIT
+2 ;Q:'$$GET1^DIQ(52,RX,9999999.23,"I") ; Only display activity log for autofinished prescriptions
+3 NEW ACTD,ALP,AD,COM,BRK
+4 DO ACTLOG^APSPFNC1(.ACTD,RX)
+5 IF $DATA(ACTD)
Begin DoDot:1
+6 SET CNT=CNT+1
+7 SET @ORY@(CNT)=" "
+8 SET CNT=CNT+1
+9 SET @ORY@(CNT)="Activity Log"
+10 SET CNT=CNT+1
+11 SET @ORY@(CNT)="# Date Reason Rx Ref Initiator Of Activity"
+12 SET CNT=CNT+1
+13 SET $PIECE(@ORY@(CNT),"=",79)="="
+14 SET ALP=0
FOR
SET ALP=$ORDER(ACTD(ALP))
IF 'ALP
QUIT
Begin DoDot:2
+15 SET AD=ACTD(ALP)
SET IENS=$PIECE(AD,U)_","_RX_","
+16 SET COM=$PIECE(AD,U,6)
+17 SET CNT=CNT+1
+18 SET @ORY@(CNT)=$PIECE(AD,U)_" "_$PIECE($$FMTE^XLFDT($PIECE(AD,U,2),"2Z"),"@")_" "_$$LJ^XLFSTR($$GET1^DIQ(52.3,IENS,.02),15)_$$LJ^XLFSTR($$GET1^DIQ(52.3,IENS,.03),15)_$$GET1^DIQ(52.3,IENS,.03)
+19 IF $LENGTH($PIECE(AD,U,7))!($LENGTH($PIECE(AD,U,8)))
Begin DoDot:3
+20 SET CNT=CNT+1
+21 SET @ORY@(CNT)=$$LJ^XLFSTR("Device: "_$PIECE(AD,U,7),50)_" Type: "_$$GET1^DIQ(52.3,IENS,9999999.02)
End DoDot:3
+22 IF $LENGTH(COM)
Begin DoDot:3
+23 IF $LENGTH(COM)<71
Begin DoDot:4
+24 SET CNT=CNT+1
+25 SET @ORY@(CNT)="Comments: "_COM
End DoDot:4
+26 IF '$TEST
Begin DoDot:4
+27 IF $EXTRACT(COM,1,70)'[" "
Begin DoDot:5
+28 SET CNT=CNT+1
+29 SET @ORY@(CNT)="Comments: "_$EXTRACT(COM,1,70)
+30 SET CNT=CNT+1
+31 SET @ORY@(CNT)=$EXTRACT(COM,71,245)
End DoDot:5
+32 IF '$TEST
Begin DoDot:5
+33 FOR BRK=245:-1
IF BRK=0
QUIT
IF $EXTRACT(COM,BRK)=" "
IF BRK<71
Begin DoDot:6
+34 SET CNT=CNT+1
+35 SET @ORY@(CNT)="Comments: "_$EXTRACT(COM,1,BRK)
+36 SET CNT=CNT+1
+37 SET @ORY@(CNT)=$EXTRACT(COM,BRK,245)
End DoDot:6
QUIT
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+38 QUIT
