source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCXPND1.m@ 1801

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

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