source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCXPND1.m@ 613

Last change on this file since 613 was 613, checked in by George Lilly, 14 years ago

initial load of WorldVistAEHR
File size: 9.3 KB
Line 
1ORCXPND1 ; SLC/MKB - Expanded Display cont ; 04/25/2007
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,67,75,89,92,94,148,159,188,172,215,243**;Dec 17, 1997;Build 242
3 ;
4 ; External References
5 ; DBIA 2387 ^LAB(60
6 ; DBIA 3420 ^DPT( file #2
7 ; DBIA 10035 ^DPT( file #2
8 ; DBIA 10037 EN^DGRPD
9 ; DBIA 700 DIS^DGRPDB
10 ; DBIA 2926 RT^GMRCGUIA
11 ; DBIA 2925 DT^GMRCSLM2 ^TMP("GMRCR"
12 ; DBIA 2503 RR^LR7OR1 ^TMP("LRRR"
13 ; DBIA 2951 EN1^LR7OSBR ^TMP("LRC"
14 ; DBIA 2952 EN^LR7OSMZ0
15 ; DBIA 2400 OEL^PSOORRL ^TMP("PS"
16 ; DBIA 2877 EN3^RAO7PC3
17 ; DBIA 2877 EN30^RAO7PC3
18 ; DBIA 1252 $$OUTPTPR^SDUTL3
19 ; DBIA 1252 $$OUTPTTM^SDUTL3
20 ; DBIA 2832 RPC^TIUSRV
21 ; DBIA 10061 DEM^VADPT
22 ; DBIA 10061 KVAR^VADPT
23 ; DBIA 10061 OAD^VADPT
24 ; DBIA 10103 $$FMTE^XLFDT
25 ; DBIA 4408 DISP^DGIBDSP
26 ;
27COVER ; -- Cover Sheet
28 N PKG S PKG=$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,4)
29 D ALLERGY^ORCXPND2:PKG="GMRA",NOTES:PKG="TIU"
30 Q
31NOTES ; -- Progress Notes
32 N I,ORY,DATE,AUTHOR,PTLOC,SUBJ K ^TMP("TIUAUDIT",$J)
33 D RPC^TIUSRV(.ORY,ID)
34 S I=0 F S I=$O(@ORY@(I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$G(@ORY@(I,0))
35 K @ORY
36 Q
37PROBLEMS ; -- Problem List
38 D PL^ORCXPND4
39 Q
40MEDS ; -- Pharmacy
41 ;N NODE,ORIFN
42 K ^TMP("PS",$J)
43 D OEL^PSOORRL(+ORVP,ID) ;S NODE=$G(^TMP("PS",$J,0)),ORIFN=+$P(NODE,U,11)
44 S ID=+$P($G(^TMP("PS",$J,0)),U,11) D ORDERS ;DBIA 2400
45 ;D @($S($P($G(^OR(100,ORIFN,0)),U,11)=$O(^ORD(100.98,"B","IV RX",0)):"IV",1:"DRUG")_"^ORCXPND2")
46 K ^TMP("PS",$J)
47 Q
48LABS ; -- Laboratory [RESULTS ONLY for ID=OE order #]
49 N ORIFN,X,SUB,TEST,NAME,SS,IDE,IVDT,TST,CCNT,ORCY,IG,TCNT
50 K ^TMP("LRRR",$J) ;DBIA 2503
51 I (ID?2.5U1" "2N1" "1.N1"-"7N1"."1.4N)!(ID?2.5U1" "2N1" "1.N1"-"7N) D AP^ORCXPND3 Q ;ID=Accession #-Date/time specimen taken
52 S ORIFN=+ID,IDE=$G(^OR(100,+ID,4)) Q:'$L(IDE) ; OE# -> Lab#
53 I +IDE D RR^LR7OR1(+ORVP,IDE) I '$D(^TMP("LRRR",$J,+ORVP)) S $P(IDE,";",1,3)=";;" ;Order possibly purged, reset to lookup on file 63
54 I '+IDE,$P(IDE,";",5) D RR^LR7OR1(+ORVP,,9999999-$P(IDE,";",5),9999999-$P(IDE,";",5),$P(IDE,";",4))
55 K ORCY D TEXT^ORQ12(.ORCY,ORIFN,80)
56 S IG=0 F S IG=$O(ORCY(IG)) Q:IG<1 S X=ORCY(IG) D ITEM^ORCXPND(X)
57 D BLANK^ORCXPND I '$D(^TMP("LRRR",$J,+ORVP)) S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="No data available." Q
58 M TEST=^TMP("LRRR",$J,+ORVP) S CCNT=0,SS=""
59 F S SS=$O(TEST(SS)) Q:SS="" S IVDT=0 F S IVDT=$O(TEST(SS,IVDT)) Q:'IVDT D
60 . I SS="BB" D
61 .. I $$GET^XPAR("DIV^SYS^PKG","OR VBECS ON",1,"Q"),$L($T(EN^ORWLR1)),$L($T(CPRS^VBECA3B)) D Q ;Transition to VBEC's interface
62 ... K ^TMP("ORLRC",$J)
63 ... D EN^ORWLR1(DFN)
64 ... I '$O(^TMP("ORLRC",$J,0)) S ^TMP("ORLRC",$J,1,0)="",^TMP("ORLRC",$J,2,0)="No Blood Bank report available..."
65 ... N I S I=0 F S I=$O(^TMP("ORLRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X
66 ... K ^TMP("ORLRC",$J)
67 .. K ^TMP("LRC",$J) D EN1^LR7OSBR(+ORVP) Q:'$D(^TMP("LRC",$J)) D Q ;DBIA 2951
68 ... N I S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X
69 ... K ^TMP("LRC",$J)
70 . I SS="MI" K ^TMP("LRC",$J) D EN^LR7OSMZ0(+ORVP) Q:'$D(^TMP("LRC",$J)) D Q
71 .. N I S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X
72 .. K ^TMP("LRC",$J)
73 . I SS="CH" D Q
74 .. S (TCNT,TST)=0 F S TST=$O(TEST(SS,IVDT,TST)) Q:TST="" S CCNT=0,TCNT=TCNT+1 D
75 ... I TCNT=1 D
76 .... S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Collection time: "_$$FMTE^XLFDT(9999999-IVDT,1)
77 .... S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$$S(1,CCNT," ")_$$S(3,CCNT,"Test Name")_$$S(29,CCNT,"Result")_$$S(39,CCNT,"Units")_$$S(55,CCNT,"Range") D:$D(IOUON) SETVIDEO^ORCXPND(LCNT,1,70,IOUON,IOUOFF)
78 ... I TST S X=TEST(SS,IVDT,TST),CCNT=0 I +X D
79 .... S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$$S(1,CCNT,$P(^LAB(60,+X,0),U))_$$S(26,CCNT,$J($P(X,U,2),7))_$$S(34,CCNT,$S($L($P(X,U,3)):$P(X,U,3),1:""))_$$S(39,CCNT,$P(X,U,4))_$$S(45,CCNT,$J($P(X,U,5),15))
80 .... I $L($P(X,U,3)),$D(IOINHI) D SETVIDEO^ORCXPND(LCNT,26,8,IOINHI,IOINORM)
81 .... I $P(X,U,3)["*",$D(IOBON),$D(IOINHI) D SETVIDEO^ORCXPND(LCNT,26,8,IOBON_IOINHI,IOBOFF_IOINORM)
82 ... I TST="N" S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Comments: " D
83 .... N CMT S CMT=0 F S CMT=$O(TEST(SS,IVDT,"N",CMT)) Q:'CMT S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" "_TEST(SS,IVDT,"N",CMT)
84 K ^TMP("LRRR",$J)
85 Q
86 ;
87DELAY ; -- Delayed Orders
88NEW ; -- New Orders
89ORDERS ; -- Orders
90 I '$G(ORESULTS) D ORDERS^ORCXPND2 Q
91 ; -- Results Display (Add more packages as available)
92 N PKG,TAB,ORIFN
93 S PKG=+$P($G(^OR(100,+ID,0)),"^",14),PKG=$$NMSP^ORCD(PKG)
94 S TAB=$S(PKG="LR":"LABS",PKG="GMRC":"CONSULTS",PKG="RA":"XRAYS",1:"")
95 I '$L(TAB)!(ID'>0) D Q ; no display available
96 . N ORY,I D TEXT^ORQ12(.ORY,+ID,80)
97 . S I=0 F S I=$O(ORY(I)) Q:I'>0 D ITEM^ORCXPND(ORY(I))
98 . D BLANK^ORCXPND
99 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="There are no results to report."
100 I $O(^OR(100,+ID,2,0)) S ORIFN=+ID,ID=0 F S ID=$O(^OR(100,ORIFN,2,ID)) Q:ID<1 I $D(^OR(100,ID,0)) D @TAB
101 I '$O(^OR(100,+ID,2,0)) D @TAB
102 Q
103REPORTS ; -- Patient Profiles
104 D EN^ORCXPNDR ; Reports
105 Q
106CONSULTS ; -- Consults
107 N I,X,SUB,ORTX ;,VALMAR
108 I $G(ORTAB)="CONSULTS" S X=$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,4)
109 E D TEXT^ORQ12(.ORTX,+ID) S X=ORTX(1),ID=+$G(^OR(100,+ID,4)) ; OE->GMRC order#
110 D ITEM^ORCXPND(X),BLANK^ORCXPND
111 I ID'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="No data available." Q
112 I '$G(ORESULTS) D ;DT action
113 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Consult No.: "_ID
114 . N GMRCOER S GMRCOER=2 D DT^GMRCSLM2(ID) S SUB="DT" ;DBIA 2925
115 I $G(ORESULTS) D RT^GMRCGUIA(ID,"^TMP(""GMRCR"",$J,""RT"")") S SUB="RT"
116 S I=0 F S I=$O(^TMP("GMRCR",$J,SUB,I)) Q:I'>0 S X=$G(^(I,0)),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X ;DBIA 2925
117 K ^TMP("GMRCR",$J)
118 Q
119XRAYS ; -- Radiology
120 I '$G(ORESULTS) S ID=+ORVP_U_$TR(ID,"-","^") D EN3^RAO7PC3(ID)
121 I $G(ORESULTS) S ID=+$G(^OR(100,+ID,4)) D EN30^RAO7PC3(ID)
122 N CASE,PROC,PSET S PSET=$D(^TMP($J,"RAE3",+ORVP,"PRINT_SET"))
123 S CASE=0 F S CASE=$O(^TMP($J,"RAE3",+ORVP,CASE)) Q:CASE'>0 D
124 . I PSET S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,"")) D ITEM^ORCXPND(PROC) Q
125 . S PROC="" F S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,PROC)) Q:PROC="" D ITEM^ORCXPND(PROC),BLANK^ORCXPND,XRPT,BLANK^ORCXPND
126 I PSET S CASE=$O(^TMP($J,"RAE3",+ORVP,0)),PROC=$O(^(CASE,"")) D BLANK^ORCXPND,XRPT,BLANK^ORCXPND ;printset=list all procs, then one report
127 K ^TMP($J,"RAE3",+ORVP),^UTILITY($J,"W")
128 S VALM("RM")=81
129 Q
130 ;
131XRPT ; -- Body of Report for CASE, PROC
132 N ORD,X,I
133 S ORD=$S($L($G(^TMP($J,"RAE3",+ORVP,"ORD"))):^("ORD"),$L($G(^("ORD",CASE))):^(CASE),1:"") I $L(ORD),ORD'=PROC S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Proc Ord: "_ORD
134 S I=1 F S I=$O(^TMP($J,"RAE3",+ORVP,CASE,PROC,I)) Q:I'>0 S X=^(I),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X ;Skip pt ID on line 1
135 Q
136 ;
137SUMMRIES ; -- Discharge Summaries
138 N I,ORY,DATE,AUTHOR,PTLOC,SUBJ K ^TMP("TIUAUDIT",$J)
139 D RPC^TIUSRV(.ORY,ID)
140 S I=0 F S I=$O(@ORY@(I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$G(@ORY@(I,0))
141 K @ORY
142 Q
143PTINQ ; Print Patient Inquiry in List Manager
144 N DFN,ORI,X
145 S DFN=+ORVP
146 D DGINQ(DFN)
147 S ORI=4,LCNT=0
148 F S ORI=$O(^TMP("ORDATA",$J,1,ORI)) Q:'ORI S X=^(ORI) D
149 . S LCNT=LCNT+1
150 . S ^TMP("ORXPND",$J,LCNT,0)=X
151 K ^TMP("ORDATA",$J,1)
152 Q
153 ;
154DGINQ(DFN) ; Patient Inquiry
155 D START^ORWRP(80,"DGINQB^ORCXPND1(DFN)")
156 Q
157DGINQB(DFN) ; Build Patient Inquiry
158 N CONTACT,ORDOC,ORTEAM,ORVP,XQORNOD,ORSSTRT,ORSSTOPT,VAOA
159 S ORVP=DFN_";DPT(",XQORNOD=1
160 D EN^DGRPD ; MAS Patient Inquiry
161 ;
162 S ORDOC=$$OUTPTPR^SDUTL3(DFN)
163 S ORTEAM=$$OUTPTTM^SDUTL3(DFN)
164 I ORDOC!ORTEAM D
165 . W !!,"Primary Care Information:"
166 . I ORDOC W !,"Primary Practitioner: ",$P(ORDOC,"^",2)
167 . I ORTEAM W !,"Primary Care Team: ",$P(ORTEAM,"^",2)
168 W !!,"Health Insurance Information:"
169 D DISP^DGIBDSP ;DBIA #4408
170 W !!,"Service Connection/Rated Disabilities:"
171 D DIS^DGRPDB
172 F CONTACT="N","S" D
173 .S VAOA("A")=$S(CONTACT="N":"",1:3)
174 .D OAD^VADPT ; Get NOK Information
175 .I VAOA(9)]"" D
176 .. W !!,$S(CONTACT="N":"Next of Kin Information:",1:"Secondary Next of Kin Information:")
177 .. W !,"Name: ",VAOA(9) ; NOK Name
178 .. I VAOA(10)]"" W " (",VAOA(10),")" ; Relationship
179 .. I VAOA(1)]"" W !?7,VAOA(1) ; Address Line 1
180 .. I VAOA(2)]"" W !?7,VAOA(2) ; Line 2
181 .. I VAOA(3)]"" W !?7,VAOA(3) ; Line 3
182 .. I VAOA(4)]"" D
183 .. . W !?7,VAOA(4) ; City
184 .. . I VAOA(5)]"" W ", "_$P(VAOA(5),"^",2) ; State
185 .. . W " ",$P(VAOA(11),"^",2) ; Zip+4
186 .. I VAOA(8)]"" W !!?7,"Phone number: ",VAOA(8) ; Phone
187 .. I CONTACT="N",$P($G(^DPT(DFN,.21)),U,11)]"" W !?7,"Work phone number: ",$P(^DPT(DFN,.21),U,11)
188 .. I CONTACT="S",$P($G(^DPT(DFN,.211)),U,11)]"" W !?7,"Work phone number: ",$P(^DPT(DFN,.211),U,11)
189 D KVAR^VADPT
190 Q
191TRIM(X) ; Trim Spaces
192 S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
193 F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
194 Q X
195S(X,Y,Z) ; Pad Over
196 ; X=Column #
197 ; Y=Current Length
198 ; Z=Text
199 ; SP=Text Sent
200 ; CCNT=Line Position After Input Text
201 I '$D(Z) Q ""
202 N SP S SP=Z I X,Y,X>Y S SP=$E(" ",1,X-Y)_Z
203 S CCNT=$$INC(CCNT,SP)
204 Q SP
205INC(X,Y) ; Character Position Count
206 ; X=Current Count
207 ; Y=Text
208 N INC S INC=X+$L(Y)
209 Q INC
Note: See TracBrowser for help on using the repository browser.