ORQ21.m

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