source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWTIU.m@ 789

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

revised back to 6/30/08 version

File size: 2.7 KB
RevLine 
[623]1ORWTIU ; slc/REV - Functions for GUI PARAMETER ACTIONS ; 08 Feb 2001 09:02AM
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,132,195**;Dec 17, 1997
3 ;
4GTTIUCTX(Y,ORUSER) ; Returns current Notes view context for user
5 N OCCLIM,SHOWSUB
6 S Y=$$GET^XPAR("ALL","ORCH CONTEXT NOTES",1)
7 I +$P(Y,";",5)=0 D
8 . S OCCLIM=$P($$PERSPRF^TIULE(DUZ),U,10)
9 . S:+OCCLIM>0 $P(Y,";",5)=OCCLIM
10 S SHOWSUB=$P(Y,";",6)
11 S $P(Y,";",6)=$S(SHOWSUB'="":SHOWSUB,1:0)
12 Q
13SVTIUCTX(Y,ORCTXT) ; Save new Notes view preferences for user
14 N TMP
15 S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1)
16 I TMP'="" D Q
17 . D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1,ORCTXT)
18 D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1,ORCTXT)
19 Q
20 ;
21GTDCCTX(Y,ORUSER) ; Returns current DC Summary view context for user
22 N OCCLIM,SHOWSUB
23 S Y=$$GET^XPAR("ALL","ORCH CONTEXT SUMMRIES",1)
24 I +$P(Y,";",5)=0 D
25 . S OCCLIM=$P($$PERSPRF^TIULE(DUZ),U,10)
26 . S:+OCCLIM>0 $P(Y,";",5)=OCCLIM
27 S SHOWSUB=$P(Y,";",6)
28 S $P(Y,";",6)=$S(SHOWSUB'="":SHOWSUB,1:0)
29 Q
30SVDCCTX(Y,ORCTXT) ; Save new DC Summary view preferences for user
31 N TMP
32 S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1)
33 I TMP'="" D Q
34 . D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1,ORCTXT)
35 D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1,ORCTXT)
36 Q
37 ;
38PRINTW(ORY,ORDA,ORFLG) ;TIU print to windows printer
39 N ZTQUEUED,ORHFS,ORSUB,ORIO,ORSTATUS,ROOT,ORERR,ORWIN,ORHANDLE
40 N IOM,IOSL,IOST,IOF,IOT,IOS
41 S (ORSUB,ROOT)="ORDATA",ORIO="OR WINDOWS HFS",ORWIN=1,ORHANDLE="ORWTIU"
42 S ORY=$NA(^TMP(ORSUB,$J,1))
43 S ORHFS=$$HFS^ORWRP()
44 D HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
45 I POP D Q
46 . I $D(ROOT) D SETITEM^ORWRP(.ROOT,"ERROR: Unable to open HFS file for TIU print")
47 D IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
48 N $ETRAP,$ESTACK
49 S $ETRAP="D ERR^ORWRP Q"
50 U IO
51 D RPC^TIUPD(.ORERR,ORDA,ORIO,ORFLG,ORWIN)
52 D HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
53 Q
54GTLSTITM(ORY,ORTIUDA) ; Return single listbox item for document
55 Q:+$G(ORTIUDA)=0
56 S ORY=ORTIUDA_U_$$RESOLVE^TIUSRVLO(ORTIUDA)
57 Q
58IDNOTES(ORY) ; Is ID Notes installed?
59 S ORY=$$PATCH^XPDUTL("TIU*1.0*100")
60 Q
61CANLINK(ORY,ORTITLE) ;Can the title be an ID child?
62 ; DBIA #2322
63 S ORY=$$CANLINK^TIULP(ORTITLE)
64 Q
65GETCP(ORY,ORTIUDA) ; Checks required CP fields before signature
66 S ORY=""
67 N ORTITLE,ORAUTH,ORCOS,ORPSUMCD,ORPROCDT,ORROOT,ORERR
68 S ORERR="",ORROOT=$NA(^TMP("ORTIU",$J))
69 D EXTRACT^TIULQ(ORTIUDA,.ORROOT,.ORERR,".01;1202;1208;70201;70202",,,"I")
70 S ORTITLE=@ORROOT@(ORTIUDA,".01","I")
71 S ORAUTH=@ORROOT@(ORTIUDA,"1202","I")
72 S ORCOS=@ORROOT@(ORTIUDA,"1208","I")
73 S ORPSUMCD=@ORROOT@(ORTIUDA,"70201","I")
74 S ORPROCDT=@ORROOT@(ORTIUDA,"70202","I")
75 S ORY=ORAUTH_U_ORCOS_U_ORPSUMCD_U_ORPROCDT_U_ORTITLE
76 K @ORROOT
77 Q
78CHKTXT(ORY,ORTIUDA) ; Checks for presence of text before signature
79 S ORY='$$EMPTYDOC^TIULF(ORTIUDA) ;DBIA #4426
80 Q
Note: See TracBrowser for help on using the repository browser.