source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWSR.m@ 1801

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

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1ORWSR ;SLC/REV-Surgery RPCs ;08/27/03
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,116,132,148,160,190,274**;Dec 17, 1997;Build 20
3 ;
4SHOWSURG(ORY) ;is Surgery ES patch installed?
5 S ORY=$$PATCH^XPDUTL("SR*3.0*100")
6 Q:+ORY=0
7 S ORY=$$GET^XPAR("ALL","ORWOR SHOW SURGERY TAB",1)
8 Q
9LIST(ORY,ORDFN,ORBDT,OREDT,ORCTXT,ORMAX,ORFHIE) ;RETURN LIST OF SURGERY CASES FOR A PATIENT
10 Q:'$$PATCH^XPDUTL("SR*3.0*100")
11 N I,J,X,SHOWADD,SHOWDOCS
12 S ORY=$NA(^TMP("ORLIST",$J))
13 Q:'+ORDFN
14 S:'$G(ORCTXT) ORCTXT=1
15 S:'$G(ORBDT) ORBDT=""
16 S:'$G(OREDT) OREDT=""
17 S:'$G(ORMAX) ORMAX=""
18 S (SHOWDOCS,SHOWADD)=1
19 D LIST^SROESTV(.ORY,ORDFN,ORBDT,OREDT,ORMAX,SHOWDOCS)
20 S I=0
21 F S I=$O(@ORY@(I)) Q:+I=0 D
22 . S X=@ORY@(I),J=0
23 . S $P(X,U,6)=$$NON^SROESTV(+X)
24 . S $P(X,U,14)=ORCTXT
25 . S $P(X,U,13)=$P(X,U,5),$P(X,U,5)=""
26 . S @ORY@(I)=X
27 . F S J=$O(@ORY@(I,J)) Q:+J=0 D
28 . . S X=@ORY@(I,J)
29 . . S:(($P(X,U,14)=ORCTXT)!($P(X,U,14)="")) $P(X,U,14)=+$P(X,U,10)
30 . . S @ORY@(I,J)=X
31 Q
32CASELIST(ORY,ORDFN) ; retrieve list of cases, but no documents
33 Q:'$$PATCH^XPDUTL("SR*3.0*100")
34 Q:'+ORDFN
35 N ORBDT,OREDT,ORMAX,I,SHOWDOCS S (ORBDT,OREDT,ORMAX)="",SHOWDOCS=0
36 S ORY=$NA(^TMP("ORLIST",$J))
37 D LIST^SROESTV(.ORY,ORDFN,ORBDT,OREDT,ORMAX,SHOWDOCS)
38 S I=0
39 F S I=$O(@ORY@(I)) Q:+I=0 D
40 . S $P(@ORY@(I),U,4)=$P($P(@ORY@(I),U,4),";",2)
41 Q
42GTSURCTX(Y,ORUSER) ; Returns current Notes view context for user
43 N OCCLIM,SHOWSUB
44 S Y=$$GET^XPAR("ALL","ORCH CONTEXT SURGERY",1)
45 Q
46SVSURCTX(Y,ORCTXT) ; Save new Notes view preferences for user
47 N TMP
48 S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT SURGERY",1)
49 I TMP'="" D Q
50 . D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT SURGERY",1,ORCTXT)
51 D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT SURGERY",1,ORCTXT)
52 Q
53 ;
54ONECASE(ORY,ORTIUDA) ;Given a TIU document, return the case and related documents
55 Q:'$$PATCH^XPDUTL("SR*3.0*100")!(+$G(ORTIUDA)=0)
56 N ORCASE
57 D GET1405^TIUSRVR(.ORCASE,ORTIUDA)
58 I +ORCASE'>0 S ORY=ORCASE Q
59 D GETONE(.ORY,+ORCASE)
60 Q
61GETONE(ORY,ORCASE) ; called by ONECASE and RPTTEXT
62 ;Q:'$$PATCH^XPDUTL("SR*3.0*100")
63 N ORTMP,J,SHOWADD,ORCTXT
64 S SHOWADD=1,ORCTXT=1
65 D ONE^SROESTV("ORY",+ORCASE)
66 S X=ORY(+ORCASE),J=0
67 S $P(X,U,6)=$$NON^SROESTV(+X)
68 S $P(X,U,14)=ORCTXT
69 S $P(X,U,13)=$P(X,U,5),$P(X,U,5)=""
70 S ORTMP(0)=X
71 F S J=$O(ORY(+ORCASE,J)) Q:+J=0 D
72 . S X=ORY(+ORCASE,J)
73 . S:(($P(X,U,14)=ORCTXT)!($P(X,U,14)="")) $P(X,U,14)=+$P(X,U,10)
74 . S ORTMP(J)=X
75 K ORY M ORY=ORTMP
76 Q
77SHOWOPTP(ORY,ORCASE) ;Should OpTop be displayed on signature?
78 I '$$PATCH^XPDUTL("SR*3.0*100") S ORY=0 Q
79 S ORY=$$OPTOP^SROESTV(+ORCASE)
80 Q
81ISNONOR(ORY,ORCASE) ;Is the procedure a non-OR procedure?
82 I '$$PATCH^XPDUTL("SR*3.0*100") S ORY=0 Q
83 S ORY=$$NON^SROESTV(+ORCASE)
84 Q
85RPTLIST(ORY,ORDFN) ;Return list of surgery reports for reports tab
86 ;I '$$PATCH^XPDUTL("SR*3.0*100") D NOTYET(.ORY) Q
87 Q:'$$PATCH^XPDUTL("SR*3.0*100")
88 Q:'+ORDFN
89 N ORBDT,OREDT,ORMAX,I,SHOWDOCS,X,SITE
90 S (ORBDT,OREDT,ORMAX)="",SHOWDOCS=0
91 S ORY=$NA(^TMP("ORLIST",$J))
92 S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",2)_";"_$P(SITE,"^",3)
93 D LIST^SROESTV(.ORY,ORDFN,ORBDT,OREDT,ORMAX,SHOWDOCS)
94 S I=0
95 F S I=$O(@ORY@(I)) Q:+I=0 D
96 . S X=$P(@ORY@(I),U,2),$P(@ORY@(I),U,2)=$P(@ORY@(I),U,3),$P(@ORY@(I),U,3)=X
97 . S $P(@ORY@(I),U,4)=$P($P(@ORY@(I),U,4),";",2)
98 . S GMN=$P(@ORY@(I),U)
99 . S $P(@ORY@(I),U,6)="LAB WORK-"_$S($O(^SRF(GMN,9,0)):"Yes",1:"No") ; Lab work
100 . D STATUS^GMTSROB S:'$D(STATUS) STATUS="UNKNOWN"
101 . S $P(@ORY@(I),U,7)="STATUS-"_STATUS ; op status
102 . S Z=$P(^SRF(GMN,0),U,4) I Z>0 S Y=Z,C=$P(^DD(130,.04,0),U,2) D Y^DIQ S SPEC=Y K Y
103 . S $P(@ORY@(I),U,8)="SPEC-"_$G(SPEC) ; Surgical specialty
104 . S Z=$P($G(^SRF(GMN,31)),U,6) S:Z>0 DCTDTM=$$DATE^ORDVU(Z)
105 . S $P(@ORY@(I),U,9)="DICT-"_$G(DCTDTM) ; Dictation Time
106 . S Z=$P($G(^SRF(GMN,31)),U,7) S:Z>0 TRSDTM=$$DATE^ORDVU(Z)
107 . S $P(@ORY@(I),U,10)="TRANS-"_$G(TRSDTM) ; Transcription Time
108 . S @ORY@(I)=SITE_U_@ORY@(I)
109 Q
110RPTTEXT(ROOT,DFN,ORID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- return surgery report
111 ;I '$$PATCH^XPDUTL("SR*3.0*100") D NOTYET(.ROOT) Q
112 Q:'$$PATCH^XPDUTL("SR*3.0*100")
113 Q:+ORID=0
114 N X,ORI,J,ORDOC,ORCASE,CNT,LINES,ORSEP,ORTMP
115 S (X,ORI)="",$P(ORSEP,"=",74)=""
116 S ROOT=$NA(^TMP("ORXPND",$J))
117 K @ROOT
118 S CNT=0
119 D GETONE(.ORCASE,ORID)
120 S (ORI,J)=""
121 F S ORI=$O(ORCASE(ORI)) Q:ORI="" D
122 . S ORTMP(ORID,ORI)=ORCASE(ORI)
123 K ORCASE M ORCASE=ORTMP
124 S ORI=""
125 F S ORI=$O(ORCASE(ORID,ORI)) Q:ORI="" D
126 . Q:'$L($P(ORCASE(ORID,ORI),U,10))
127 . Q:$E($P(ORCASE(ORID,ORI),U,2),1,8)="Addendum"
128 . D TGET^TIUSRVR1(.ORDOC,+ORCASE(ORID,ORI),"VIEW")
129 . S J="",LINES=0
130 . F S J=$O(@ORDOC@(J)) Q:J="" D
131 . . I $D(@ORDOC@(J))=10 D
132 . . . S @ROOT@(J+CNT,0)=@ORDOC@(J,0),LINES=LINES+1
133 . . E S @ROOT@(J+CNT,0)=@ORDOC@(J),LINES=LINES+1
134 . K ORDOC,ORY(ORID) S CNT=CNT+LINES+1
135 . S @ROOT@(CNT,0)=ORSEP,CNT=CNT+1
136 I CNT=0 S @ROOT@(CNT,0)="No reports are available for this case."
137 Q
138NOTYET(ROOT) ; -- standard not available display text
139 D SETITEM(.ROOT,"Report not available at this time.")
140 Q
141SETITEM(ROOT,X) ; -- set item in list
142 S @ROOT@($O(@ROOT@(9999),-1)+1)=X
143 Q
Note: See TracBrowser for help on using the repository browser.