source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDIS12.m@ 1288

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1VAQDIS12 ;ALB/JFP - PDX,SELECTION SCREEN FOR DISPLAY BY REQUESTOR;01MAR93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3EP ; -- Main entry point for the list processor
4 I '($D(DUZ)) W !,"Duz required for this option" D PAUSE^VALM1 QUIT
5 ;
6 N VAQDZN,VAQFLAG,VAQECNT,VAQRSLT,VAQUNSOL,X0,STATUS,TRDE
7 S VAQDZN=$S($D(DUZ):$P(^VA(200,DUZ,0),U,1),1:"")
8 K XQORS,VALMEVL
9 D EN^VALM("VAQ DIS REQUESTOR PDX10") ; -- Protocol = VAQ PDX9 (MENU)
10 QUIT
11 ;
12INIT ; -- Builds array of PDX transactions by requestor
13 K ^TMP("VAQD1",$J),^TMP("VAQIDX",$J)
14 ;
15 D STATPTR^VAQUTL95 ; -- Sets PDX status pointers (vaq-rslt,vaq-unsol)
16 ;
17 D:$D(XRTL) T0^%ZOSV ; -- Capacity start
18 S TRDE="",(VAQECNT,VALMCNT)=0
19 F S TRDE=$O(^VAT(394.61,"AC",VAQDZN,TRDE)) Q:TRDE="" D SETD
20 I VAQECNT=0 D
21 .S VAQTRN=0,X=$$SETSTR^VALM1(" ","",1,79) D TMP
22 .S X=$$SETSTR^VALM1(" ** PDX results not found for this requestor... ","",1,80) D TMP
23 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop
24 QUIT
25 ;
26SETD ; -- Set data for display in list processor
27 S VAQCSTAT=$P($G(^VAT(394.61,TRDE,0)),U,2)
28 ; -- Filter out transaction without results
29 I ((VAQCSTAT)'=VAQRSLT)&((VAQCSTAT)'=VAQUNSOL) QUIT
30 ; -- Filter out transactions marked as purged OR excides life cap
31 S VAQFLAG=$$EXPTRN^VAQUTL97(TRDE)
32 Q:VAQFLAG=1
33 ;
34 S X0=$$TRNDATA^VAQUTL92(TRDE) ; -- Extracts data from transaction file
35 S STATUS=$S(VAQCSTAT'="":$P($G(^VAT(394.85,VAQCSTAT,0)),U,2),1:" ")
36 S:VAQADT'="" DATETIME=VAQADT_" (Rs)"
37 S:VAQADT="" DATETIME=VAQRDT_" (Rq)"
38 S VAQECNT=VAQECNT+1
39 S X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
40 S X=$$SETFLD^VALM1(VAQADOM,X,"DOMAIN")
41 S X=$$SETFLD^VALM1(DATETIME,X,"DATE")
42 S X=$$SETFLD^VALM1(VAQTRN,X,"TRNO")
43 D TMP
44 S X=$$SETSTR^VALM1(VAQPTNM,"",7,80) D TMP
45 S X=$$SETSTR^VALM1(" ","",1,80) D TMP ; -- null line
46 D KILLTRN^VAQUTL92 ; -- Cleans up variables set in TRNDATA
47 QUIT
48 ;
49HD ; -- Make header line for list processor
50 S X=$$SETSTR^VALM1("Requestor: "_VAQDZN,"",1,79)
51 S VALMHDR(1)=" ",VALMHDR(2)=X,VALMHDR(3)=" "
52 QUIT
53 ;
54SEL ; -- Selects patient to display, checks sensative patient
55 N VALMY,SDI,SDAT
56 S:'$D(VAQBCK) VAQBCK=0
57 D EN^VALM2($G(XQORNOD(0)),"S")
58 Q:'$D(VALMY)
59 S SDI=""
60 S SDI=$O(VALMY(SDI)) Q:SDI=""
61 S SDAT=$G(^TMP("VAQIDX",$J,SDI))
62 S VAQTRN=$P(SDAT,U,2),DFN=""
63 S (VAQDFN,DFN)=$O(^VAT(394.61,"B",VAQTRN,DFN))
64 I $P($G(^VAT(394.61,DFN,0)),U,4)=1 D WORKLD^VAQDIS11
65 D EP^VAQDIS15 ; -- Display segments
66 I VAQBCK=1 K VALMBCK QUIT
67 D INIT
68 S VALMBCK="R"
69 QUIT
70 ;
71TMP ; -- Set the array used by list processor
72 S VALMCNT=VALMCNT+1
73 S ^TMP("VAQD1",$J,VALMCNT,0)=$E(X,1,79)
74 S ^TMP("VAQD1",$J,"IDX",VALMCNT,VAQECNT)=""
75 S ^TMP("VAQIDX",$J,VAQECNT)=VALMCNT_"^"_VAQTRN
76 QUIT
77 ;
78EXIT ; -- Note: The list processor cleans up its own variables.
79 ; All other variables cleaned up here.
80 ;
81 K VAQFLAG,VAQECNT,VAQRSLT,VAQUNSOL,X0,STATUS,TRDE
82 K POP,VAQBCK,VAQDFN,DFN,ENTRY
83 K DATETIME,VAQCSTAT
84 K VAQADFL ; -- set in VAQDIS01 (display min)
85 K ^TMP("VAQD1",$J),^TMP("VAQIDX",$J)
86 QUIT
87 ;
88END ; -- End of code
89 QUIT
Note: See TracBrowser for help on using the repository browser.