ORQ21 ;SLC/MKB,GSS - DETAILED ORDER REPORT CONTINUED ;Sep 14, 2020@12:05:08
;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,190,195,215,243,361,350,417,377,521,405**;Dec 17, 1997;Build 211
;;Per VHA Directive 6402, this routine should not be modified.
;
; DBIA 2400 OEL^PSOORRL ^TMP("PS",$J)
; DBIA 2266 EN30^RAO7PC1 ^TMP($J,"RAE2")
; DBIA 2058 ^DIC(9.4, Direct Global Read
;
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
; p521 changed the next line
;N TYPE,NODE,RXN,OR5,STAT,ORIDG,ORCIDG S TYPE=$P(OR0,U,12)
N TYPE,NODE,RXN,OR5,STAT,ORIDG,ORCIDG S TYPE=$$GETPKG ; p521 use package instead of patient class
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 ORIDG=$O(^ORD(100.98,"B","IV MEDICATIONS","")),ORCIDG=$O(^ORD(100.98,"B","CLINIC INFUSIONS",""))
I "^"_ORIDG_"^"_ORCIDG_"^"'[("^"_$P(OR0,"^",11)_"^") D
. 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=$G(^(I,0))
. S X=$S($L(X,U)=1:X,1:$P(X,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)
. S X="Removal Times: ",I=0 ;OR*3.0*417
. F S I=$O(^TMP("PS",$J,"RMV",I)) Q:I'>0 S Y=$G(^(I,0)) S:$L(Y) CNT=CNT+1,@ORY@(CNT)=X_Y,X=$$REPEAT^XLFSTR(" ",30)
.Q
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)
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."
;ADDED FOLLWING LINE OF PAPI CODE 405
I $G(STAT)="ACTIVE/PARKED" S CNT=CNT+1,@ORY@(CNT)="Prescription Status: "_STAT_" - Order is active. Parked until next fill is requested."
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=$$ICDDATA^ICDXCODE("DIAGNOSIS",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",$G(X)="P":"Park",1:$G(X)) ;PAPI 405
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 ""
GETPKG() ; p521 added package check
N PKGIEN S PKGIEN=$$GET1^DIQ(100,ORIFN_",",12,"I")
I $P($G(^DIC(9.4,PKGIEN,0)),U)="INPATIENT MEDICATIONS" Q "I" ; DBIA2058
I $P($G(^DIC(9.4,PKGIEN,0)),U)="OUTPATIENT PHARMACY" Q "O" ; DBIA 2058
Q $$GET1^DIQ(100,ORIFN_",",10,"I") ; default to patient class if no package match
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQ21 7792 printed Dec 13, 2024@02:33:10 Page 2
ORQ21 ;SLC/MKB,GSS - DETAILED ORDER REPORT CONTINUED ;Sep 14, 2020@12:05:08
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,190,195,215,243,361,350,417,377,521,405**;Dec 17, 1997;Build 211
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 ;
+4 ; DBIA 2400 OEL^PSOORRL ^TMP("PS",$J)
+5 ; DBIA 2266 EN30^RAO7PC1 ^TMP($J,"RAE2")
+6 ; DBIA 2058 ^DIC(9.4, Direct Global Read
+7 ;
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 ; p521 changed the next line
+3 ;N TYPE,NODE,RXN,OR5,STAT,ORIDG,ORCIDG S TYPE=$P(OR0,U,12)
+4 ; p521 use package instead of patient class
NEW TYPE,NODE,RXN,OR5,STAT,ORIDG,ORCIDG
SET TYPE=$$GETPKG
+5 ;get PS data / DBIA 2400
IF '$DATA(^TMP("PS",$JOB,0))
Begin DoDot:1
+6 NEW PSIFN
SET PSIFN=$GET(^OR(100,ORIFN,4))
+7 if TYPE="O"
SET PSIFN=$TRANSLATE(PSIFN,"S","P")_$SELECT(PSIFN?1.N:"R",1:"")
+8 ;DBIA 2400
DO OEL^PSOORRL(+ORVP,PSIFN_";"_TYPE)
End DoDot:1
+9 SET NODE=$GET(^TMP("PS",$JOB,0))
SET RXN=$GET(^("RXN",0))
SET STAT=$PIECE(NODE,U,6)
+10 ;error
IF '$LENGTH(NODE)
KILL ^TMP("PS",$JOB)
QUIT
+11 ;Disp Drugs
IF $ORDER(^TMP("PS",$JOB,"DD",0))
Begin DoDot:1
+12 NEW I,X,Y
SET X="Dispense Drugs (units/dose): "
SET I=0
+13 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
+14 SET ORIDG=$ORDER(^ORD(100.98,"B","IV MEDICATIONS",""))
SET ORCIDG=$ORDER(^ORD(100.98,"B","CLINIC INFUSIONS",""))
+15 IF "^"_ORIDG_"^"_ORCIDG_"^"'[("^"_$PIECE(OR0,"^",11)_"^")
Begin DoDot:1
+16 if $PIECE(NODE,U,9)
SET CNT=CNT+1
SET @ORY@(CNT)="Total Dose: "_$PIECE(NODE,U,9)
End DoDot:1
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=$GET(^(I,0))
+5 SET X=$SELECT($LENGTH(X,U)=1:X,1:$PIECE(X,U,2))
+6 if $LENGTH(X)
SET CNT=CNT+1
SET @ORY@(CNT)="Schedule Type: "_X
+7 SET X="Administration Times: "
SET I=0
+8 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)
+9 ;OR*3.0*417
SET X="Removal Times: "
SET I=0
+10 FOR
SET I=$ORDER(^TMP("PS",$JOB,"RMV",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)
+11 QUIT
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)
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 ;ADDED FOLLWING LINE OF PAPI CODE 405
+3 IF $GET(STAT)="ACTIVE/PARKED"
SET CNT=CNT+1
SET @ORY@(CNT)="Prescription Status: "_STAT_" - Order is active. Parked until next fill is requested."
+4 if $PIECE(NODE,U,13)
SET CNT=CNT+1
SET @ORY@(CNT)="NOT TO BE GIVEN"
KILL ^TMP("PS",$JOB)
+5 ;blank
SET CNT=CNT+1
SET @ORY@(CNT)=" "
+6 ;SC data
SET OR5=$GET(^OR(100,ORIFN,5))
IF $LENGTH(OR5)
Begin DoDot:1
+7 NEW X,Y,I
+8 ;blank line
SET CNT=CNT+1
SET @ORY@(CNT)=" "
+9 SET CNT=CNT+1
SET @ORY@(CNT)="First Party Pay Exemptions"
+10 SET X="For conditions related to: "
+11 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
+12 QUIT
+13 ;
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=$$ICDDATA^ICDXCODE("DIAGNOSIS",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 ;PAPI 405
NEW Y
SET Y=$SELECT($GET(X)="M":"Mail",$GET(X)="W":"Window",$GET(X)="P":"Park",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 ""
GETPKG() ; p521 added package check
+1 NEW PKGIEN
SET PKGIEN=$$GET1^DIQ(100,ORIFN_",",12,"I")
+2 ; DBIA2058
IF $PIECE($GET(^DIC(9.4,PKGIEN,0)),U)="INPATIENT MEDICATIONS"
QUIT "I"
+3 ; DBIA 2058
IF $PIECE($GET(^DIC(9.4,PKGIEN,0)),U)="OUTPATIENT PHARMACY"
QUIT "O"
+4 ; default to patient class if no package match
QUIT $$GET1^DIQ(100,ORIFN_",",10,"I")
