ORCXPND2 ; SLC/MKB - Expanded display cont ;11/16/04 09:29
;;3.0;ORDER ENTRY/RESULTS REPORTING;**34,53,75,94,141,216**;Dec 17, 1997
ALLERGY ; -- allergies
N I,J,X,Y,DATE,SEV,SOURCE D EN1^GMRAOR2(ID,"Y")
D ITEM^ORCXPND($P(Y,U)),BLANK^ORCXPND
S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Nature of Reaction: "_$S($P(Y,U,6)="ALLERGY":"Allergy",$P(Y,U,6)="PHARMACOLOGIC":"Adverse Reaction",1:"Unknown") ;216
S I=$O(Y("S",0)),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Signs/Symptoms: "_$G(Y("S",+I))
I $O(Y("S",I)) F S I=$O(Y("S",I)) Q:I'>0 D
. S LCNT=LCNT+1
. S ^TMP("ORXPND",$J,LCNT,0)=$$REPEAT^XLFSTR(" ",21)_Y("S",I)
S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Type: "_$P(Y,U,7)
I $O(Y("V",0)) S I=0 F S I=$O(Y("V",I)) Q:I'>0 D
. S LCNT=LCNT+1
. S ^TMP("ORXPND",$J,LCNT,0)=$$REPEAT^XLFSTR(" ",23)_$P(Y("V",I),U,2)
S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Verified: "_$S($P(Y,U,4)="VERIFIED":$P(Y,U,8),1:$P(Y,U,4)) ;216
A1 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Observed/Historical: "_$P(Y,U,5)
I $O(Y("O",0)) S I=0 F S I=$O(Y("O",I)) Q:I'>0 D ; obs dates
. S DATE=$P(Y("O",I),U),SEV=$P(Y("O",I),U,2)
. S X=$$REPEAT^XLFSTR(" ",23)_$$DATE(DATE)_$S($L(SEV):" ("_SEV_")",1:"")
. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X
S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Originator: "_$P(Y,U,2)
S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$$REPEAT^XLFSTR(" ",21)_$P(Y,U,3)
I $O(Y("C",0)) S I=0 F S I=$O(Y("C",I)) Q:I'>0 D ; comments
. D BLANK^ORCXPND
. S DATE=$P(Y("C",I),U),SOURCE=$P(Y("C",I),U,2)
. S:SOURCE="ORIGINATOR" SOURCE=$P(Y,U,2) ; use name
. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$J($$DATE(DATE),20)_" "_SOURCE
. S J=0 F S J=$O(Y("C",I,J)) Q:J'>0 D
. . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=Y("C",I,J,0)
Q
;
XRAY ; -- Single xray report per procedure
N CASE,PROC
S CASE=0 F S CASE=$O(^TMP($J,"RAE2",+ORVP,CASE)) Q:CASE'>0 D
. S PROC="" F S PROC=$O(^TMP($J,"RAE2",+ORVP,CASE,PROC)) Q:PROC="" D ITEM^ORCXPND(PROC),BLANK^ORCXPND,XRPT,BLANK^ORCXPND
Q
;
XRSET ; -- Print set of one report for many procedures
N CASE,PROC
S CASE=0 F S CASE=$O(^TMP($J,"RAE2",+ORVP,CASE)) Q:CASE'>0 D
. S PROC=$O(^TMP($J,"RAE2",+ORVP,CASE,"")) D ITEM^ORCXPND(PROC)
S CASE=$O(^TMP($J,"RAE2",+ORVP,0)),PROC=$O(^(CASE,"")) ;1st case
D BLANK^ORCXPND,XRPT,BLANK^ORCXPND
Q
;
XRPT ; -- body of report for CASE, PROC
N NODE,ST,ORD,X,I,ORIFN,REQPROV
S ORD=$S($L($G(^TMP($J,"RAE2",+ORVP,"ORD"))):^("ORD"),$L($G(^("ORD",CASE))):^(CASE),1:"") I $L(ORD),ORD'=PROC S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Proc Ordered : "_ORD
I $G(EXAMDATE) S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Exam Date : "_$$DATETIME^ORCHTAB(EXAMDATE)
I $D(CASENMBR) D ; Case number(s)
. S X="" I $G(CASENMBR)<0 S X=$P(CASENMBR,U,2)
. E S I="" F S I=$O(CASENMBR(I)) Q:I="" S X=X_$S($L(X):", ",1:"")_I
. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Case No. : "_X
S NODE=$G(^TMP($J,"RAE2",+ORVP,CASE,PROC)),ORIFN=$P(NODE,U,3)
I ORIFN S REQPROV=+$P($G(^OR(100,+ORIFN,0)),U,4) S:REQPROV LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Req Provider : "_$$GET1^DIQ(200,REQPROV_",",.01) ;216
S ST=$P(NODE,U),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Report Status : "_ST
I $P(NODE,U,2)="Y" S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" ** ABNORMAL RESULTS **" D:$D(IOINHI) CNTRL^VALM10(LCNT,13,22,IOINHI,IOINORM)
D BLANK^ORCXPND S X="Exam Modifiers: "
I '$O(^TMP($J,"RAE2",+ORVP,CASE,PROC,"M",0)) S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X_"none"
E S I=0 F S I=$O(^TMP($J,"RAE2",+ORVP,CASE,PROC,"M",I)) Q:I'>0 S X=X_^(I),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X,X=" "
XR1 Q:$$UP^XLFSTR(ST)="NO REPORT"
D XRTEXT("Clinical History: ","H")
D XRTEXT("Report: ","R")
D XRTEXT("Impression: ","I")
D XRTEXT("Diagnostic Code: ","D"),BLANK^ORCXPND
S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Verified by: "_$P($G(^TMP($J,"RAE2",+ORVP,CASE,PROC,"V")),U,2)
Q
;
XRTEXT(CAPTION,SUB) ; -- include wp text
N DIWL,DIWF,DIWR,ORI,X D BLANK^ORCXPND
S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=CAPTION
S DIWL=1,DIWF="C75" K ^UTILITY($J,"W")
S ORI=0 F S ORI=$O(^TMP($J,"RAE2",+ORVP,CASE,PROC,SUB,ORI)) Q:ORI'>0 S X=^(ORI) D ^DIWP
S ORI=0 F S ORI=$O(^UTILITY($J,"W",DIWL,ORI)) Q:ORI'>0 S X=^(ORI,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X
K ^UTILITY($J,"W")
Q
;
ORDERS ; -- orders
N ORYY,I
S ORYY="^TMP(""ORTXT"",$J)"
D DETAIL^ORQ2(.ORYY,+ID)
S I=0 F S I=$O(@ORYY@(I)) Q:I'>0 D
. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=@ORYY@(I)
. I $D(@ORYY@("VIDEO",I)) M ^TMP("ORXPND",$J,"VIDEO",LCNT)=@ORYY@("VIDEO",I)
Q
;
DATE(X) ; -- Return formatted date
N Y S Y=""
S:X Y=$$FMTE^XLFDT(X,"2M") ;21
Q Y
;
DRUG ; -- UD or Outpt med
N INPT,X,Y,PROV,DRUG,I,FILLD,RXN
S INPT=($P(ID,";",2)="I"),DRUG=$P(NODE,U),PROV=$G(^TMP("PS",$J,"P",0))
D ITEM^ORCXPND(DRUG),BLANK^ORCXPND
S RXN=$G(^TMP("PS",$J,"RXN",0)) I RXN S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Prescription#: "_$P(RXN,U)
S:PROV LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Prescriber: "_$P(PROV,U,2)
S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Total Dose: "_$P(NODE,U,9)
S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Units/Dose: "_$P(NODE,U,10)
D MULT("MDR","Route:")
D MULT("SCH","Schedule:")
S X=$S(INPT:"Instructions:",1:"Sig:") D WP("SIG",X)
D WP("PC","Provider Comments:"),WP("SIO","Other Instructions:")
D BLANK^ORCXPND
D1 I 'INPT D
. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Days Supply: "_$P(NODE,U,7)
. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Quantity: "_$P(NODE,U,8)
. S:$P(NODE,U,12) LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Last Filled: "_$$FMTE^XLFDT($P(NODE,U,12),2)
. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Refills Remaining: "_$P(NODE,U,4)
D2 . 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 I=0 F S I=$O(^TMP("PS",$J,"REF",I)) Q:I'>0 S FILLD=$G(^(I,0)) D FILLED("R")
. 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")
D3 I INPT,$D(^TMP("PS",$J,"ADM")) D
. N I,X S X="Admin Times: ",I=0
. F S I=$O(^TMP("PS",$J,"ADM",I)) Q:I'>0 S Y=$G(^(I,0)) S:$L(Y) LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X_Y,X=" "
D BLANK^ORCXPND,SDATES
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 LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X_Y,X=" "
S:$L($P(FILLD,U,6)) LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X_$P(FILLD,U,6)
Q
;
ROUTING(X) ; -- Returns external form
N Y S Y=$S($G(X)="M":"Mail",$G(X)="W":"Window",1:$G(X))
Q Y
;
IV ; -- IV Fluid
N PROV S PROV=$G(^TMP("PS",$J,"P",0))
D ITEM^ORCXPND("IV Fluid"),BLANK^ORCXPND
S:PROV LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Prescriber: "_$P(PROV,U,2)
D MULT("B","Solution:")
D MULT("A","Additive:")
S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Infusion Rate: "_$P(NODE,U,2)
D WP("PC","Provider Comments:"),BLANK^ORCXPND
D SDATES
Q
;
;
MULT(SUB,CAPTION) ; -- add multiple valued item
N I,FIRST,SPACES,X S FIRST=1,I=0,SPACES=" "
F S I=$O(^TMP("PS",$J,SUB,I)) Q:I'>0 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$S(FIRST:CAPTION,1:"")_$E(SPACES,1,20-$L(CAPTION))_$TR(X,"^"," "),FIRST=0,CAPTION=""
Q
;
WP(SUB,CAPTION) ; -- add wp item
N ORI,FIRST,SPACES,DIWL,DIWR,DIWF,X
S DIWL=1,DIWR=60,DIWF="C60",ORI=0 K ^UTILITY($J,"W")
F S ORI=$O(^TMP("PS",$J,SUB,ORI)) Q:ORI'>0 S X=^(ORI,0) D ^DIWP
S FIRST=1,ORI=0,SPACES=" "
F S ORI=$O(^UTILITY($J,"W",DIWL,ORI)) Q:ORI'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$S(FIRST:CAPTION,1:"")_$E(SPACES,1,20-$L(CAPTION))_^(ORI,0),FIRST=0,CAPTION=""
K ^UTILITY($J,"W")
Q
SDATES ; -- add start & stop dates, status
N RXN S RXN=$G(^TMP("PS",$J,"RXN",0))
I $P(RXN,U,5) S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Pharmacist: "_$$GET1^DIQ(200,+$P(RXN,U,5)_",",.01) ;216
S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Start Date: "_$$FMTE^XLFDT($P(NODE,U,5),"2P")
S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Stop Date: "_$$FMTE^XLFDT($P(NODE,U,3),"2P")
S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Status: "_$P(NODE,U,6)
S:$P(NODE,U,11) LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Order #"_+$P(NODE,U,11)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCXPND2 8592 printed Apr 09, 2024@21:37:40 Page 2
ORCXPND2 ; SLC/MKB - Expanded display cont ;11/16/04 09:29
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**34,53,75,94,141,216**;Dec 17, 1997
ALLERGY ; -- allergies
+1 NEW I,J,X,Y,DATE,SEV,SOURCE
DO EN1^GMRAOR2(ID,"Y")
+2 DO ITEM^ORCXPND($PIECE(Y,U))
DO BLANK^ORCXPND
+3 ;216
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=" Nature of Reaction: "_$SELECT($PIECE(Y,U,6)="ALLERGY":"Allergy",$PIECE(Y,U,6)="PHARMACOLOGIC":"Adverse Reaction",1:"Unknown")
+4 SET I=$ORDER(Y("S",0))
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=" Signs/Symptoms: "_$GET(Y("S",+I))
+5 IF $ORDER(Y("S",I))
FOR
SET I=$ORDER(Y("S",I))
if I'>0
QUIT
Begin DoDot:1
+6 SET LCNT=LCNT+1
+7 SET ^TMP("ORXPND",$JOB,LCNT,0)=$$REPEAT^XLFSTR(" ",21)_Y("S",I)
End DoDot:1
+8 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=" Type: "_$PIECE(Y,U,7)
+9 IF $ORDER(Y("V",0))
SET I=0
FOR
SET I=$ORDER(Y("V",I))
if I'>0
QUIT
Begin DoDot:1
+10 SET LCNT=LCNT+1
+11 SET ^TMP("ORXPND",$JOB,LCNT,0)=$$REPEAT^XLFSTR(" ",23)_$PIECE(Y("V",I),U,2)
End DoDot:1
+12 ;216
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=" Verified: "_$SELECT($PIECE(Y,U,4)="VERIFIED":$PIECE(Y,U,8),1:$PIECE(Y,U,4))
A1 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Observed/Historical: "_$PIECE(Y,U,5)
+1 ; obs dates
IF $ORDER(Y("O",0))
SET I=0
FOR
SET I=$ORDER(Y("O",I))
if I'>0
QUIT
Begin DoDot:1
+2 SET DATE=$PIECE(Y("O",I),U)
SET SEV=$PIECE(Y("O",I),U,2)
+3 SET X=$$REPEAT^XLFSTR(" ",23)_$$DATE(DATE)_$SELECT($LENGTH(SEV):" ("_SEV_")",1:"")
+4 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X
End DoDot:1
+5 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=" Originator: "_$PIECE(Y,U,2)
+6 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=$$REPEAT^XLFSTR(" ",21)_$PIECE(Y,U,3)
+7 ; comments
IF $ORDER(Y("C",0))
SET I=0
FOR
SET I=$ORDER(Y("C",I))
if I'>0
QUIT
Begin DoDot:1
+8 DO BLANK^ORCXPND
+9 SET DATE=$PIECE(Y("C",I),U)
SET SOURCE=$PIECE(Y("C",I),U,2)
+10 ; use name
if SOURCE="ORIGINATOR"
SET SOURCE=$PIECE(Y,U,2)
+11 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=$JUSTIFY($$DATE(DATE),20)_" "_SOURCE
+12 SET J=0
FOR
SET J=$ORDER(Y("C",I,J))
if J'>0
QUIT
Begin DoDot:2
+13 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=Y("C",I,J,0)
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
XRAY ; -- Single xray report per procedure
+1 NEW CASE,PROC
+2 SET CASE=0
FOR
SET CASE=$ORDER(^TMP($JOB,"RAE2",+ORVP,CASE))
if CASE'>0
QUIT
Begin DoDot:1
+3 SET PROC=""
FOR
SET PROC=$ORDER(^TMP($JOB,"RAE2",+ORVP,CASE,PROC))
if PROC=""
QUIT
DO ITEM^ORCXPND(PROC)
DO BLANK^ORCXPND
DO XRPT
DO BLANK^ORCXPND
End DoDot:1
+4 QUIT
+5 ;
XRSET ; -- Print set of one report for many procedures
+1 NEW CASE,PROC
+2 SET CASE=0
FOR
SET CASE=$ORDER(^TMP($JOB,"RAE2",+ORVP,CASE))
if CASE'>0
QUIT
Begin DoDot:1
+3 SET PROC=$ORDER(^TMP($JOB,"RAE2",+ORVP,CASE,""))
DO ITEM^ORCXPND(PROC)
End DoDot:1
+4 ;1st case
SET CASE=$ORDER(^TMP($JOB,"RAE2",+ORVP,0))
SET PROC=$ORDER(^(CASE,""))
+5 DO BLANK^ORCXPND
DO XRPT
DO BLANK^ORCXPND
+6 QUIT
+7 ;
XRPT ; -- body of report for CASE, PROC
+1 NEW NODE,ST,ORD,X,I,ORIFN,REQPROV
+2 SET ORD=$SELECT($LENGTH($GET(^TMP($JOB,"RAE2",+ORVP,"ORD"))):^("ORD"),$LENGTH($GET(^("ORD",CASE))):^(CASE),1:"")
IF $LENGTH(ORD)
IF ORD'=PROC
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Proc Ordered : "_ORD
+3 IF $GET(EXAMDATE)
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Exam Date : "_$$DATETIME^ORCHTAB(EXAMDATE)
+4 ; Case number(s)
IF $DATA(CASENMBR)
Begin DoDot:1
+5 SET X=""
IF $GET(CASENMBR)<0
SET X=$PIECE(CASENMBR,U,2)
+6 IF '$TEST
SET I=""
FOR
SET I=$ORDER(CASENMBR(I))
if I=""
QUIT
SET X=X_$SELECT($LENGTH(X):", ",1:"")_I
+7 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Case No. : "_X
End DoDot:1
+8 SET NODE=$GET(^TMP($JOB,"RAE2",+ORVP,CASE,PROC))
SET ORIFN=$PIECE(NODE,U,3)
+9 ;216
IF ORIFN
SET REQPROV=+$PIECE($GET(^OR(100,+ORIFN,0)),U,4)
if REQPROV
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Req Provider : "_$$GET1^DIQ(200,REQPROV_",",.01)
+10 SET ST=$PIECE(NODE,U)
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Report Status : "_ST
+11 IF $PIECE(NODE,U,2)="Y"
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=" ** ABNORMAL RESULTS **"
if $DATA(IOINHI)
DO CNTRL^VALM10(LCNT,13,22,IOINHI,IOINORM)
+12 DO BLANK^ORCXPND
SET X="Exam Modifiers: "
+13 IF '$ORDER(^TMP($JOB,"RAE2",+ORVP,CASE,PROC,"M",0))
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X_"none"
+14 IF '$TEST
SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"RAE2",+ORVP,CASE,PROC,"M",I))
if I'>0
QUIT
SET X=X_^(I)
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X
SET X=" "
XR1 if $$UP^XLFSTR(ST)="NO REPORT"
QUIT
+1 DO XRTEXT("Clinical History: ","H")
+2 DO XRTEXT("Report: ","R")
+3 DO XRTEXT("Impression: ","I")
+4 DO XRTEXT("Diagnostic Code: ","D")
DO BLANK^ORCXPND
+5 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Verified by: "_$PIECE($GET(^TMP($JOB,"RAE2",+ORVP,CASE,PROC,"V")),U,2)
+6 QUIT
+7 ;
XRTEXT(CAPTION,SUB) ; -- include wp text
+1 NEW DIWL,DIWF,DIWR,ORI,X
DO BLANK^ORCXPND
+2 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=CAPTION
+3 SET DIWL=1
SET DIWF="C75"
KILL ^UTILITY($JOB,"W")
+4 SET ORI=0
FOR
SET ORI=$ORDER(^TMP($JOB,"RAE2",+ORVP,CASE,PROC,SUB,ORI))
if ORI'>0
QUIT
SET X=^(ORI)
DO ^DIWP
+5 SET ORI=0
FOR
SET ORI=$ORDER(^UTILITY($JOB,"W",DIWL,ORI))
if ORI'>0
QUIT
SET X=^(ORI,0)
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X
+6 KILL ^UTILITY($JOB,"W")
+7 QUIT
+8 ;
ORDERS ; -- orders
+1 NEW ORYY,I
+2 SET ORYY="^TMP(""ORTXT"",$J)"
+3 DO DETAIL^ORQ2(.ORYY,+ID)
+4 SET I=0
FOR
SET I=$ORDER(@ORYY@(I))
if I'>0
QUIT
Begin DoDot:1
+5 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=@ORYY@(I)
+6 IF $DATA(@ORYY@("VIDEO",I))
MERGE ^TMP("ORXPND",$JOB,"VIDEO",LCNT)=@ORYY@("VIDEO",I)
End DoDot:1
+7 QUIT
+8 ;
DATE(X) ; -- Return formatted date
+1 NEW Y
SET Y=""
+2 ;21
if X
SET Y=$$FMTE^XLFDT(X,"2M")
+3 QUIT Y
+4 ;
DRUG ; -- UD or Outpt med
+1 NEW INPT,X,Y,PROV,DRUG,I,FILLD,RXN
+2 SET INPT=($PIECE(ID,";",2)="I")
SET DRUG=$PIECE(NODE,U)
SET PROV=$GET(^TMP("PS",$JOB,"P",0))
+3 DO ITEM^ORCXPND(DRUG)
DO BLANK^ORCXPND
+4 SET RXN=$GET(^TMP("PS",$JOB,"RXN",0))
IF RXN
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Prescription#: "_$PIECE(RXN,U)
+5 if PROV
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Prescriber: "_$PIECE(PROV,U,2)
+6 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Total Dose: "_$PIECE(NODE,U,9)
+7 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Units/Dose: "_$PIECE(NODE,U,10)
+8 DO MULT("MDR","Route:")
+9 DO MULT("SCH","Schedule:")
+10 SET X=$SELECT(INPT:"Instructions:",1:"Sig:")
DO WP("SIG",X)
+11 DO WP("PC","Provider Comments:")
DO WP("SIO","Other Instructions:")
+12 DO BLANK^ORCXPND
D1 IF 'INPT
Begin DoDot:1
+1 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Days Supply: "_$PIECE(NODE,U,7)
+2 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Quantity: "_$PIECE(NODE,U,8)
+3 if $PIECE(NODE,U,12)
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Last Filled: "_$$FMTE^XLFDT($PIECE(NODE,U,12),2)
+4 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Refills Remaining: "_$PIECE(NODE,U,4)
D2 IF $PIECE(RXN,U,6)!$GET(^TMP("PS",$JOB,"REF",0))
SET X="Filled: "
Begin DoDot:2
+1 IF $PIECE(RXN,U,6)
SET FILLD=$PIECE(RXN,U,6)_"^^^"_$PIECE(RXN,U,7)_U_$PIECE(RXN,U,3,4)
DO FILLED("R")
+2 SET I=0
FOR
SET I=$ORDER(^TMP("PS",$JOB,"REF",I))
if I'>0
QUIT
SET FILLD=$GET(^(I,0))
DO FILLED("R")
End DoDot:2
+3 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")
End DoDot:1
D3 IF INPT
IF $DATA(^TMP("PS",$JOB,"ADM"))
Begin DoDot:1
+1 NEW I,X
SET X="Admin Times: "
SET I=0
+2 FOR
SET I=$ORDER(^TMP("PS",$JOB,"ADM",I))
if I'>0
QUIT
SET Y=$GET(^(I,0))
if $LENGTH(Y)
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X_Y
SET X=" "
End DoDot:1
+3 DO BLANK^ORCXPND
DO SDATES
+4 QUIT
+5 ;
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 LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X_Y
SET X=" "
+5 if $LENGTH($PIECE(FILLD,U,6))
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X_$PIECE(FILLD,U,6)
+6 QUIT
+7 ;
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 ;
IV ; -- IV Fluid
+1 NEW PROV
SET PROV=$GET(^TMP("PS",$JOB,"P",0))
+2 DO ITEM^ORCXPND("IV Fluid")
DO BLANK^ORCXPND
+3 if PROV
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Prescriber: "_$PIECE(PROV,U,2)
+4 DO MULT("B","Solution:")
+5 DO MULT("A","Additive:")
+6 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Infusion Rate: "_$PIECE(NODE,U,2)
+7 DO WP("PC","Provider Comments:")
DO BLANK^ORCXPND
+8 DO SDATES
+9 QUIT
+10 ;
+11 ;
MULT(SUB,CAPTION) ; -- add multiple valued item
+1 NEW I,FIRST,SPACES,X
SET FIRST=1
SET I=0
SET SPACES=" "
+2 FOR
SET I=$ORDER(^TMP("PS",$JOB,SUB,I))
if I'>0
QUIT
SET X=^(I,0)
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=$SELECT(FIRST:CAPTION,1:"")_$EXTRACT(SPACES,1,20-$LENGTH(CAPTION))_$TRANSLATE(X,"^"," ")
SET FIRST=0
SET CAPTION=""
+3 QUIT
+4 ;
WP(SUB,CAPTION) ; -- add wp item
+1 NEW ORI,FIRST,SPACES,DIWL,DIWR,DIWF,X
+2 SET DIWL=1
SET DIWR=60
SET DIWF="C60"
SET ORI=0
KILL ^UTILITY($JOB,"W")
+3 FOR
SET ORI=$ORDER(^TMP("PS",$JOB,SUB,ORI))
if ORI'>0
QUIT
SET X=^(ORI,0)
DO ^DIWP
+4 SET FIRST=1
SET ORI=0
SET SPACES=" "
+5 FOR
SET ORI=$ORDER(^UTILITY($JOB,"W",DIWL,ORI))
if ORI'>0
QUIT
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=$SELECT(FIRST:CAPTION,1:"")_$EXTRACT(SPACES,1,20-$LENGTH(CAPTION))_^(ORI,0)
SET FIRST=0
SET CAPTION=""
+6 KILL ^UTILITY($JOB,"W")
+7 QUIT
SDATES ; -- add start & stop dates, status
+1 NEW RXN
SET RXN=$GET(^TMP("PS",$JOB,"RXN",0))
+2 ;216
IF $PIECE(RXN,U,5)
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Pharmacist: "_$$GET1^DIQ(200,+$PIECE(RXN,U,5)_",",.01)
+3 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Start Date: "_$$FMTE^XLFDT($PIECE(NODE,U,5),"2P")
+4 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Stop Date: "_$$FMTE^XLFDT($PIECE(NODE,U,3),"2P")
+5 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Status: "_$PIECE(NODE,U,6)
+6 if $PIECE(NODE,U,11)
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="Order #"_+$PIECE(NODE,U,11)
+7 QUIT
