source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDIS15.m@ 1374

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

initial load of WorldVistAEHR
File size: 4.0 KB
RevLine 
[613]1VAQDIS15 ;ALB/JFP - PDX,DISPLAY SEGMENTS FOR DISPLAY;01MAR93
2 ;;1.5;PATIENT DATA EXCHANGE;**1,17**;NOV 17, 1993
3EP ; -- Main entry point for the list processor
4 ; -- K XQORS,VALMEVL (only kill on the first screen in)
5 D EN^VALM("VAQ DISPLAY SEGMENT PDX11") ; -- protocol = VAQ PDX11 (MENU)
6 ;K VALMBCK
7 QUIT
8 ;
9INIT ; -- Initializes variables and defines screen
10 K ^TMP("VAQD2",$J)
11 S (VAQECNT,VALMCNT,SEGDE)=0
12 ;
13 I '$D(^VAT(394.61,DFN,"SEG",0)) D QUIT
14 .S X=$$SETSTR^VALM1(" ","",1,79) D TMP
15 .S X=$$SETSTR^VALM1(" ** No Segment(s)... <Return> to exit ","",1,79)
16 .D TMP
17 ;
18 F S SEGDE=$O(^VAT(394.61,DFN,"SEG","B",SEGDE)) Q:SEGDE="" D
19 .S SEGMNU=$P($G(^VAT(394.71,SEGDE,0)),U,2)
20 .S SEGNM=$P($G(^VAT(394.71,SEGDE,0)),U,1)
21 .S VAQECNT=VAQECNT+1
22 .S X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
23 .S X=$$SETFLD^VALM1(SEGMNU,X,"SEGMENTS")
24 .S X=$$SETFLD^VALM1(SEGNM,X,"SEGNAME")
25 .D TMP
26 QUIT
27 ;
28TMP ; -- Set the array used by list processor
29 S VALMCNT=VALMCNT+1
30 S ^TMP("VAQD2",$J,VALMCNT,0)=$E(X,1,79)
31 S ^TMP("VAQD2",$J,"IDX",VALMCNT,VAQECNT)=""
32 S ^TMP("VAQIDXSG",$J,VAQECNT)=SEGDE_"^"_SEGMNU
33 QUIT
34 ;
35HD ; -- Make header line for list processor
36 N X0,X1,X2
37 S X0=$$TRNDATA^VAQUTL92(VAQDFN) ; -- sets variable from transaction file
38 S X1=$$SETSTR^VALM1("Patient: "_VAQPTNM,"",1,41)
39 S X1=$$SETSTR^VALM1("Remote Domain: "_VAQADOM,X1,42,79)
40 S:VAQPTID="" X2=$$SETSTR^VALM1(" SSN: "_VAQESSN,"",1,41)
41 S:VAQPTID'="" X2=$$SETSTR^VALM1(" ID: "_VAQPTID,"",1,41)
42 S X2=$$SETSTR^VALM1(" Date/Time: "_VAQADT,X2,42,79)
43 ;
44 S VALMHDR(1)=" "
45 S VALMHDR(2)=$E(X1,1,79)
46 S VALMHDR(3)=$E(X2,1,79)
47 ;
48 D KILLTRN^VAQUTL92 ; -- cleans up variables set in TRNDATA CALL
49 K X0,X1,X2
50 QUIT
51 ;
52 ; ------------------------ PROTOCOLS -------------------------------
53SEL ; -- Selected segment(s) for display
54 D SEL^VALM2
55 Q:'$D(VALMY)
56 S VALMCNT=1
57 S ROOT="^TMP(""VAQD3"",$J)" K @ROOT
58 D CLEAR^VALM1
59 S X=$$DEVICE^VAQDIS17("SEL")
60 ; -- Added call to INIT to clear variables
61 I X=-1 W !,"Error in getting device" D INIT S VALMBCK="R" QUIT
62 I X=0 S VALMBCK="R" G SEL2 ; -- allows for re-selection
63 S ENTRY=""
64 F S ENTRY=$O(VALMY(ENTRY)) Q:ENTRY="" D BLDDIS
65 D ENDLN
66 D EP^VAQDIS16
67SEL2 D INIT
68 S VALMBCK="R"
69 QUIT
70 ;
71ALL ; -- Selects all segments for display
72 I '$D(^TMP("VAQIDXSG",$J)) S VALMBCK="Q" QUIT
73 S VALMCNT=1
74 S ROOT="^TMP(""VAQD3"",$J)" K @ROOT
75 D CLEAR^VALM1
76 S X=$$DEVICE^VAQDIS17("ALL")
77 I X=-1 W !,"Error in getting device" D INIT S VALMBCK="R" QUIT
78 I X=0 K VALMBCK QUIT
79 S ENTRY=""
80 F S ENTRY=$O(^TMP("VAQIDXSG",$J,ENTRY)) Q:ENTRY="" D BLDDIS
81 D ENDLN
82 D EP^VAQDIS16
83 K VALMBCK
84 QUIT
85 ;
86TRANEX D PAUSE^VALM1
87 S VALMBCK=$S(VAQFLAG=0:"R",1:"Q")
88 QUIT
89 ;
90BLDDIS ; -- Builds display
91 D:$D(XRTL) T0^%ZOSV ; -- Capacity start
92 S SDAT=$G(^TMP("VAQIDXSG",$J,ENTRY))
93 S SEGDE=$P(SDAT,U,1)
94 S OFFSET=$$BLDDSP^VAQUPD2(DFN,SEGDE,ROOT,VALMCNT)
95 S:+OFFSET'=-1 VALMCNT=VALMCNT+OFFSET
96 I +OFFSET=-1 S ERRMSG=$P($G(OFFSET),U,2) D ERRMSG
97 ;W !,"Segment = ",SEGDE," Offset = ",OFFSET," VALMCNT = ",VALMCNT
98 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop
99 QUIT
100 ;
101ERRMSG ; -- Displays a message if segment could be extracted
102 S EROOT=$$ROOT^VAQDIS20(ROOT)
103 S VAQSEGND=""
104 S:SEGDE'="" VAQSEGND=$G(^VAT(394.71,SEGDE,0))
105 S VAQLN=$$REPEAT^VAQUTL1("-",79)
106 S VAQCTR="< "_$S($P(VAQSEGND,"^",1)'="":$P(VAQSEGND,"^",1),1:"Segment Description Missing")_" >"
107 S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR) D ETMP
108 S X=$$SETSTR^VALM1(" ","",1,79) D ETMP
109 S X=$$SETSTR^VALM1(" ** "_ERRMSG,"",1,79) D ETMP
110 S X=$$SETSTR^VALM1(" ","",1,79) D ETMP
111 S X=$$SETSTR^VALM1(" ","",1,79) D ETMP
112 S OFFSET=VALMCNT
113 K VAQLN,VAQCTR,VAQSEGND,X,EROOT
114 QUIT
115 ;
116ENDLN ; -- End of display
117 S EROOT=$$ROOT^VAQDIS20(ROOT)
118 S X=$$SETSTR^VALM1(" ","",1,79) D ETMP
119 S X=$$SETSTR^VALM1(" [ End of Data ]","",1,79) D ETMP
120 K EROOT
121 QUIT
122 ;
123ETMP ; -- Display for error message
124 S VALMCNT=VALMCNT+1
125 S @EROOT@(VALMCNT,0)=$E(X,1,79)
126 QUIT
127 ;
128EXIT ; -- Note: The list processor cleans up its own variables.
129 ; All other variables cleaned up here.
130 ;
131 K ^TMP("VAQD2",$J),^TMP("VAQIDXSG",$J)
132 K SEGDE,SEGMNU,SEGNM
133 K ROOT,OFFSET
134 Q
135 ;
136END ; -- End of code
137 QUIT
Note: See TracBrowser for help on using the repository browser.