source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWOR2.m@ 1352

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

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1ORWOR2 ; slc/dcm - Result RPC functions
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141**;Dec 17, 1997
3ORDHIST ; -- orders - compare with ORDERS^ORCXPND1
4 I '$G(ORESULTS) D ORDERS^ORCXPND2 Q
5 ; -- Result History Display (Add more packages as available)
6 N PKG,TAB,ORIFN
7 S PKG=+$P($G(^OR(100,+ID,0)),"^",14),PKG=$$NMSP^ORCD(PKG)
8 S TAB=$S(PKG="LR":"LABS",PKG="GMRC":"CONSULTS",PKG="RA":"XRAYS",1:"")
9 I '$L(TAB)!(ID'>0) D Q ; no display available
10 . N ORY,I
11 . D TEXT^ORQ12(.ORY,+ID,80)
12 . S I=0 F S I=$O(ORY(I)) Q:I'>0 D ITEM^ORCXPND(ORY(I))
13 . D BLANK^ORCXPND
14 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="There are no results to report in this time range."
15 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
16 I '$O(^OR(100,+ID,2,0)) D @TAB
17 Q
18LABS ; -- laboratory [RESULTS ONLY for ID=OE order #]
19 N ORIFN,X,Y,SUB,NAME,SS,IDE,IVDT,TST,CC,ORCY,IG,TCNT,ITEM,ORY,SDATE,EDATE,ITDATE,ITMDATE,NDT,STAR,LNM
20 K ^TMP("LRRR",$J),^TMP("LRAPI",$J)
21 S ORIFN=+ID,IDE=$G(^OR(100,+ID,4))
22 Q:'$L(IDE) ; OE# -> Lab#
23 S ITEM=$$VALUE^ORX8(ID,"ORDERABLE",,"I"),ITMDATE=$S($P(ID,";",2):$P($G(^OR(100,ORIFN,8,$P(ID,";",2),0)),"^",16),1:$P(^OR(100,ORIFN,0),"^",8)),ITDATE=$$FMTE^XLFDT(ITMDATE,"1M")
24 Q:'ITEM
25 S ITEM=+$P($G(^ORD(101.43,+ITEM,0)),"^",2)
26 S $P(IDE,";",1,3)=";;"
27 S SDATE=9999999-$S($P(IDE,";",5):$P(IDE,";",5),1:ITMDATE),EDATE=$$FMADD^XLFDT(DT,-1825) ;Set for previous 5 years
28 D RR^LR7OR1(+ORVP,,SDATE,EDATE,,ITEM,,5)
29 K ORCY D TEXT^ORQ12(.ORCY,ORIFN,80)
30 S IG=0 F S IG=$O(ORCY(IG)) Q:IG<1 S X=ORCY(IG) D ITEM^ORCXPND(X)
31 D BLANK^ORCXPND
32 I '$D(^TMP("LRRR",$J,+ORVP)) S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="No data available." Q
33 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Order Released: "_ITDATE_$S('$P(IDE,";",5):" (Results not yet available for this order)",1:" (* Results for this order)")
34 S CC=0,SS="",TCNT=0
35 F S SS=$O(^TMP("LRRR",$J,+ORVP,SS)) Q:SS="" S IVDT=0 F S IVDT=$O(^TMP("LRRR",$J,+ORVP,SS,IVDT)) Q:'IVDT D Q:SS="MI" Q:SS="BB"
36 . S NDT=1,STAR=" "
37 . I SS="BB" K ^TMP("LRC",$J) D EN1^LR7OSBR(+ORVP) Q:'$D(^TMP("LRC",$J)) D Q
38 .. 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
39 .. K ^TMP("LRC",$J)
40 . I SS="MI" K ^TMP("LRC",$J) D EN^LR7OSMZ0(+ORVP) Q:'$D(^TMP("LRC",$J)) D Q
41 .. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Previous 5 sets of related results within 5 years... "
42 .. 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
43 .. K ^TMP("LRC",$J)
44 . I SS="CH",$O(^TMP("LRRR",$J,+ORVP,SS,IVDT,0)) D Q
45 .. S TST=0 F S TST=$O(^TMP("LRRR",$J,+ORVP,SS,IVDT,TST)) Q:TST="" S CC=0,Y="",TCNT=TCNT+1,X=$S(TST:^TMP("LRRR",$J,+ORVP,SS,IVDT,TST),1:"") D
46 ... I TCNT=1 D
47 .... S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Previous 5 sets of related results within 5 years... "
48 .... D BLANK^ORCXPND
49 .... S CC=0,LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$$S(1,CC," ")_$$S(1,CC,"Collection Time")_$$S(21,CC,"Test Name")_$$S(34,CC,"Result")_$$S(42,CC,"Units")_$$S(58,CC,"Range")
50 .... S CC=0,LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$$S(1,CC," ")_$$S(1,CC,"------------------")_$$S(21,CC,"---------")_$$S(34,CC,"------")_$$S(42,CC,"-----")_$$S(58,CC,"-----")
51 ... I TST S X=^TMP("LRRR",$J,+ORVP,SS,IVDT,TST),CC=0 I +X D
52 .... I NDT=1,$P(IDE,";",5)=IVDT S STAR="*"
53 .... S LCNT=LCNT+1,LNM=$S($D(^LAB(60,+X,.1)):$P(^(.1),U),1:$P(^(0),U))
54 .... S ^TMP("ORXPND",$J,LCNT,0)=STAR_$S(NDT=1:$$S(1,CC,$$FMTE^XLFDT(9999999-IVDT,"1M")),1:$$S(1,CC," "))_$$S(20,CC,LNM)_$$S(30,CC,$J($P(X,U,2),7))
55 .... I $L($P(X,U,2))<8 S ^TMP("ORXPND",$J,LCNT,0)=^TMP("ORXPND",$J,LCNT,0)_$$S(36,CC,$S($L($P(X,U,3)):$P(X,U,3),1:""))_$$S(41,CC,$P(X,U,4))_$$S(47,CC,$J($P(X,U,5),15))
56 .... E S CC=0,LCNT=LCNT+1,$P(Y," ",38)="",^TMP("ORXPND",$J,LCNT,0)=$$S(1,CC,Y)_$$S(36,CC,$S($L($P(X,U,3)):$P(X,U,3),1:""))_$$S(42,CC,$P(X,U,4))_$$S(58,CC,$J($P(X,U,5),15))
57 .... S NDT=0
58 ... I TST="N" S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Comments: " D
59 .... N CMT S CMT=0 F S CMT=$O(^TMP("LRRR",$J,+ORVP,SS,IVDT,"N",CMT)) Q:'CMT S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" "_^TMP("LRRR",$J,+ORVP,SS,IVDT,"N",CMT)
60 K ^TMP("LRRR",$J),^TMP("LRAPI",$J)
61 Q
62CONSULTS ; -- consults
63 N I,X,SUB,ORTX
64 I $G(ORTAB)="CONSULTS" S X=$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,4)
65 E D TEXT^ORQ12(.ORTX,+ID) S X=ORTX(1),ID=+$G(^OR(100,+ID,4)) ; OE->GMRC order#
66 D ITEM^ORCXPND(X),BLANK^ORCXPND
67 I ID'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="No data available." Q
68 I '$G(ORESULTS) D ;DT action
69 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Consult No.: "_ID
70 . N GMRCOER S GMRCOER=2 D DT^GMRCSLM2(ID) S SUB="DT"
71 I $G(ORESULTS) D RT^GMRCGUIA(ID,"^TMP(""GMRCR"",$J,""RT"")") S SUB="RT"
72 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
73 K ^TMP("GMRCR",$J)
74 Q
75 ;
76XRAYS ; -- Radiology
77 I '$G(ORESULTS) S ID=+ORVP_U_$TR(ID,"-","^") D EN3^RAO7PC3(ID)
78 I $G(ORESULTS) S ID=+$G(^OR(100,+ID,4)) D EN30^RAO7PC3(ID)
79 N CASE,PROC,PSET
80 S PSET=$D(^TMP($J,"RAE3",+ORVP,"PRINT_SET")),CASE=0
81 F S CASE=$O(^TMP($J,"RAE3",+ORVP,CASE)) Q:CASE'>0 D
82 . I PSET S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,"")) D ITEM^ORCXPND(PROC) Q
83 . S PROC="" F S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,PROC)) Q:PROC="" D ITEM^ORCXPND(PROC),BLANK^ORCXPND,XRPT,BLANK^ORCXPND
84 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
85 K ^TMP($J,"RAE3",+ORVP) S VALM("RM")=81
86 Q
87XRPT ; -- body of report for CASE, PROC
88 N ORD,X,I
89 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
90 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
91 Q
92 ;
93S(X,Y,Z) ;Pad over
94 ;X=Column #
95 ;Y=Current length
96 ;Z=Text
97 ;SP=TEXT SENT
98 ;CC=Line position after input text
99 I '$D(Z) Q ""
100 N SP S SP=Z I X,Y,X>Y S SP=$E(" ",1,X-Y)_Z
101 S CC=$$INC(CC,SP)
102 Q SP
103INC(X,Y) ;Character position count
104 ;X=Current count
105 ;Y=Text
106 N INC S INC=X+$L(Y)
107 Q INC
Note: See TracBrowser for help on using the repository browser.