source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCXPND2.m@ 642

Last change on this file since 642 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1ORCXPND2 ; SLC/MKB - Expanded display cont ;11/16/04 09:29
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**34,53,75,94,141,216**;Dec 17, 1997
3ALLERGY ; -- allergies
4 N I,J,X,Y,DATE,SEV,SOURCE D EN1^GMRAOR2(ID,"Y")
5 D ITEM^ORCXPND($P(Y,U)),BLANK^ORCXPND
6 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
7 S I=$O(Y("S",0)),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Signs/Symptoms: "_$G(Y("S",+I))
8 I $O(Y("S",I)) F S I=$O(Y("S",I)) Q:I'>0 D
9 . S LCNT=LCNT+1
10 . S ^TMP("ORXPND",$J,LCNT,0)=$$REPEAT^XLFSTR(" ",21)_Y("S",I)
11 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Type: "_$P(Y,U,7)
12 I $O(Y("V",0)) S I=0 F S I=$O(Y("V",I)) Q:I'>0 D
13 . S LCNT=LCNT+1
14 . S ^TMP("ORXPND",$J,LCNT,0)=$$REPEAT^XLFSTR(" ",23)_$P(Y("V",I),U,2)
15 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
16A1 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Observed/Historical: "_$P(Y,U,5)
17 I $O(Y("O",0)) S I=0 F S I=$O(Y("O",I)) Q:I'>0 D ; obs dates
18 . S DATE=$P(Y("O",I),U),SEV=$P(Y("O",I),U,2)
19 . S X=$$REPEAT^XLFSTR(" ",23)_$$DATE(DATE)_$S($L(SEV):" ("_SEV_")",1:"")
20 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X
21 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Originator: "_$P(Y,U,2)
22 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$$REPEAT^XLFSTR(" ",21)_$P(Y,U,3)
23 I $O(Y("C",0)) S I=0 F S I=$O(Y("C",I)) Q:I'>0 D ; comments
24 . D BLANK^ORCXPND
25 . S DATE=$P(Y("C",I),U),SOURCE=$P(Y("C",I),U,2)
26 . S:SOURCE="ORIGINATOR" SOURCE=$P(Y,U,2) ; use name
27 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$J($$DATE(DATE),20)_" "_SOURCE
28 . S J=0 F S J=$O(Y("C",I,J)) Q:J'>0 D
29 . . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=Y("C",I,J,0)
30 Q
31 ;
32XRAY ; -- Single xray report per procedure
33 N CASE,PROC
34 S CASE=0 F S CASE=$O(^TMP($J,"RAE2",+ORVP,CASE)) Q:CASE'>0 D
35 . S PROC="" F S PROC=$O(^TMP($J,"RAE2",+ORVP,CASE,PROC)) Q:PROC="" D ITEM^ORCXPND(PROC),BLANK^ORCXPND,XRPT,BLANK^ORCXPND
36 Q
37 ;
38XRSET ; -- Print set of one report for many procedures
39 N CASE,PROC
40 S CASE=0 F S CASE=$O(^TMP($J,"RAE2",+ORVP,CASE)) Q:CASE'>0 D
41 . S PROC=$O(^TMP($J,"RAE2",+ORVP,CASE,"")) D ITEM^ORCXPND(PROC)
42 S CASE=$O(^TMP($J,"RAE2",+ORVP,0)),PROC=$O(^(CASE,"")) ;1st case
43 D BLANK^ORCXPND,XRPT,BLANK^ORCXPND
44 Q
45 ;
46XRPT ; -- body of report for CASE, PROC
47 N NODE,ST,ORD,X,I,ORIFN,REQPROV
48 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
49 I $G(EXAMDATE) S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Exam Date : "_$$DATETIME^ORCHTAB(EXAMDATE)
50 I $D(CASENMBR) D ; Case number(s)
51 . S X="" I $G(CASENMBR)<0 S X=$P(CASENMBR,U,2)
52 . E S I="" F S I=$O(CASENMBR(I)) Q:I="" S X=X_$S($L(X):", ",1:"")_I
53 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Case No. : "_X
54 S NODE=$G(^TMP($J,"RAE2",+ORVP,CASE,PROC)),ORIFN=$P(NODE,U,3)
55 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
56 S ST=$P(NODE,U),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Report Status : "_ST
57 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)
58 D BLANK^ORCXPND S X="Exam Modifiers: "
59 I '$O(^TMP($J,"RAE2",+ORVP,CASE,PROC,"M",0)) S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X_"none"
60 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=" "
61XR1 Q:$$UP^XLFSTR(ST)="NO REPORT"
62 D XRTEXT("Clinical History: ","H")
63 D XRTEXT("Report: ","R")
64 D XRTEXT("Impression: ","I")
65 D XRTEXT("Diagnostic Code: ","D"),BLANK^ORCXPND
66 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Verified by: "_$P($G(^TMP($J,"RAE2",+ORVP,CASE,PROC,"V")),U,2)
67 Q
68 ;
69XRTEXT(CAPTION,SUB) ; -- include wp text
70 N DIWL,DIWF,DIWR,ORI,X D BLANK^ORCXPND
71 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=CAPTION
72 S DIWL=1,DIWF="C75" K ^UTILITY($J,"W")
73 S ORI=0 F S ORI=$O(^TMP($J,"RAE2",+ORVP,CASE,PROC,SUB,ORI)) Q:ORI'>0 S X=^(ORI) D ^DIWP
74 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
75 K ^UTILITY($J,"W")
76 Q
77 ;
78ORDERS ; -- orders
79 N ORYY,I
80 S ORYY="^TMP(""ORTXT"",$J)"
81 D DETAIL^ORQ2(.ORYY,+ID)
82 S I=0 F S I=$O(@ORYY@(I)) Q:I'>0 D
83 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=@ORYY@(I)
84 . I $D(@ORYY@("VIDEO",I)) M ^TMP("ORXPND",$J,"VIDEO",LCNT)=@ORYY@("VIDEO",I)
85 Q
86 ;
87DATE(X) ; -- Return formatted date
88 N Y S Y=""
89 S:X Y=$$FMTE^XLFDT(X,"2M") ;21
90 Q Y
91 ;
92DRUG ; -- UD or Outpt med
93 N INPT,X,Y,PROV,DRUG,I,FILLD,RXN
94 S INPT=($P(ID,";",2)="I"),DRUG=$P(NODE,U),PROV=$G(^TMP("PS",$J,"P",0))
95 D ITEM^ORCXPND(DRUG),BLANK^ORCXPND
96 S RXN=$G(^TMP("PS",$J,"RXN",0)) I RXN S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Prescription#: "_$P(RXN,U)
97 S:PROV LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Prescriber: "_$P(PROV,U,2)
98 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Total Dose: "_$P(NODE,U,9)
99 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Units/Dose: "_$P(NODE,U,10)
100 D MULT("MDR","Route:")
101 D MULT("SCH","Schedule:")
102 S X=$S(INPT:"Instructions:",1:"Sig:") D WP("SIG",X)
103 D WP("PC","Provider Comments:"),WP("SIO","Other Instructions:")
104 D BLANK^ORCXPND
105D1 I 'INPT D
106 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Days Supply: "_$P(NODE,U,7)
107 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Quantity: "_$P(NODE,U,8)
108 . S:$P(NODE,U,12) LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Last Filled: "_$$FMTE^XLFDT($P(NODE,U,12),2)
109 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Refills Remaining: "_$P(NODE,U,4)
110D2 . I $P(RXN,U,6)!$G(^TMP("PS",$J,"REF",0)) S X="Filled: " D
111 .. I $P(RXN,U,6) S FILLD=$P(RXN,U,6)_"^^^"_$P(RXN,U,7)_U_$P(RXN,U,3,4) D FILLED("R")
112 .. S I=0 F S I=$O(^TMP("PS",$J,"REF",I)) Q:I'>0 S FILLD=$G(^(I,0)) D FILLED("R")
113 . 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")
114D3 I INPT,$D(^TMP("PS",$J,"ADM")) D
115 . N I,X S X="Admin Times: ",I=0
116 . 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=" "
117 D BLANK^ORCXPND,SDATES
118 Q
119 ;
120FILLED(TYPE) ; -- add FILLD data
121 N Y S Y=$$FMTE^XLFDT($P(FILLD,U),2)_" ("_$$ROUTING($P(FILLD,U,5))_")"
122 S:TYPE="R"&$P(FILLD,U,4) Y=Y_" released "_$$FMTE^XLFDT($P(FILLD,U,4),2)
123 S:TYPE="P"&$P(FILLD,U,3) Y=Y_" Qty: "_$P(FILLD,U,3)
124 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X_Y,X=" "
125 S:$L($P(FILLD,U,6)) LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X_$P(FILLD,U,6)
126 Q
127 ;
128ROUTING(X) ; -- Returns external form
129 N Y S Y=$S($G(X)="M":"Mail",$G(X)="W":"Window",1:$G(X))
130 Q Y
131 ;
132IV ; -- IV Fluid
133 N PROV S PROV=$G(^TMP("PS",$J,"P",0))
134 D ITEM^ORCXPND("IV Fluid"),BLANK^ORCXPND
135 S:PROV LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Prescriber: "_$P(PROV,U,2)
136 D MULT("B","Solution:")
137 D MULT("A","Additive:")
138 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Infusion Rate: "_$P(NODE,U,2)
139 D WP("PC","Provider Comments:"),BLANK^ORCXPND
140 D SDATES
141 Q
142 ;
143 ;
144MULT(SUB,CAPTION) ; -- add multiple valued item
145 N I,FIRST,SPACES,X S FIRST=1,I=0,SPACES=" "
146 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=""
147 Q
148 ;
149WP(SUB,CAPTION) ; -- add wp item
150 N ORI,FIRST,SPACES,DIWL,DIWR,DIWF,X
151 S DIWL=1,DIWR=60,DIWF="C60",ORI=0 K ^UTILITY($J,"W")
152 F S ORI=$O(^TMP("PS",$J,SUB,ORI)) Q:ORI'>0 S X=^(ORI,0) D ^DIWP
153 S FIRST=1,ORI=0,SPACES=" "
154 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=""
155 K ^UTILITY($J,"W")
156 Q
157SDATES ; -- add start & stop dates, status
158 N RXN S RXN=$G(^TMP("PS",$J,"RXN",0))
159 I $P(RXN,U,5) S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Pharmacist: "_$$GET1^DIQ(200,+$P(RXN,U,5)_",",.01) ;216
160 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Start Date: "_$$FMTE^XLFDT($P(NODE,U,5),"2P")
161 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Stop Date: "_$$FMTE^XLFDT($P(NODE,U,3),"2P")
162 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Status: "_$P(NODE,U,6)
163 S:$P(NODE,U,11) LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Order #"_+$P(NODE,U,11)
164 Q
Note: See TracBrowser for help on using the repository browser.