source: FOIAVistA/tag/r/PATIENT_DATA_EXCHANGE-VAQ/VAQEXT01.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1VAQEXT01 ;ALB/JFP - PDX, PROCESS EXTERNAL (MANUAL),PROCESS SCREEN;01MAR93
2 ;;1.5;PATIENT DATA EXCHANGE;**14,35**;NOV 17, 1993
3EP ; -- Main entry point for the list processor
4 K XQORS,VALMEVL
5 N VALMCNT S VALMCNT=0
6 D EN^VALM("VAQ PROCESS PDX3")
7 QUIT
8 ;
9INIT ; -- Builds array of PDX transactions for manual processing
10 ; (transactions with status VAQ-PROC)
11 ; NOTE: VAQ-PROC is a hard coded mnemonic, ^VAT(394.85,
12 ;
13 K ^TMP("VAQR3",$J),^TMP("VAQR3","VAQIDX",$J)
14 N STATPT,TRDE,NODE,ND,X,Y,K,J,DATETIME,SEGMENT,SEGDE,SEG,SDI,VALMY,SDAT
15 N VAQECNT,VAQTRNO,VAQPTNM,VAQISSN,VAQIDOB,VAQEDOB,VAQPTID,VAQAUST
16 N VAQAUADD,VAQRES,VAQTRDE,VAQDFN,VAQDOM,VAQSIG,VAQTRN,VAQESSN,VAQLMT
17 N VAQRST,VAQCST
18 ;
19 D:$D(XRTL) T0^%ZOSV
20 S (STATPT,TRDE,RELPTR)="",(VAQECNT,VALMCNT)=0
21 S STATPT=$O(^VAT(394.85,"B","VAQ-PROC",STATPT))
22 S RELPTR=$O(^VAT(394.85,"B","VAQ-RQACK",RELPTR))
23 F S TRDE=$O(^VAT(394.61,"STATUS",STATPT,TRDE)) Q:TRDE="" D SETD
24 I VAQECNT=0 D
25 .S VAQTRNO=0,X=$$SETSTR^VALM1(" ","",1,79) D TMP
26 .S X=$$SETSTR^VALM1(" ** No pending transactions queued for manual processing... ","",1,80) D TMP
27 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV
28 QUIT
29 ;
30SETD ; -- Set data for display in list processor
31 ; -- Filter out transactions marked as purged OR exceed life cap
32 S VAQFLAG=$$EXPTRN^VAQUTL97(TRDE)
33 Q:VAQFLAG=1
34 Q:$$CLOSTRAN^VAQUTL97(TRDE,"RQST2") ; Filter out (and mark for purging) transactions from closed domains.
35 F ND=0,"QRY","RQST1","RQST2","ATHR1","ATHR2" S NODE(ND)=$G(^VAT(394.61,TRDE,ND))
36 ; -- release status set, skip entry
37 S VAQCST=+$P(NODE(0),U,2),VAQRST=+$P(NODE(0),U,5)
38 I ($P($G(^VAT(394.85,VAQCST,0)),U,1)'="VAQ-PROC") QUIT
39 I ($P($G(^VAT(394.85,VAQRST,0)),U,1)'="VAQ-RQACK") QUIT
40 D SETD1
41 D SEG^VAQEXT06 ; -- gather segments
42 D DISDEMO
43 D DISSEG
44 S X=$$SETSTR^VALM1(" ","",1,80) D TMP ; -- null line
45 D DISMAX^VAQEXT06
46 S X=$$SETSTR^VALM1(" ","",1,80) D TMP ; -- null line
47 QUIT
48 ;
49SETD1 ; -- Extracts data for display
50 S VAQTRNO=$P(NODE(0),U,1)
51 S (Y,VAQTDTE)=$P(NODE("RQST1"),U,1)
52 X ^DD("DD") S DATETIME=Y_" (Rq)"
53 S VAQDOM=$P(NODE("RQST2"),U,1)
54 S VAQPTNM=$P(NODE("QRY"),U,1)
55 S VAQISSN=$P(NODE("QRY"),U,2)
56 S VAQIDOB=$P(NODE("QRY"),U,3),VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)
57 S VAQPTID=$P(NODE("QRY"),U,4)
58 S VAQRQST=$P(NODE("RQST2"),U,1),VAQRQADD=$P(NODE("RQST2"),U,2)
59 I VAQISSN'="" S VAQRES=$$RES^VAQUTL99(VAQRQADD,VAQISSN) ;-- reason for manual
60 I VAQISSN="" S VAQRES=$$RES^VAQUTL99(VAQRQADD,VAQPTNM) ;-- reason for manual
61 ; -- Check to see if requested segments exceed max time/occurrence limits
62 ;W !,"VAQRES = ",VAQRES
63 I $P(VAQRES,U,1)>0 D
64 .S VAQLMT=$$AUTO^VAQEXT05(TRDE)
65 .I (+VAQLMT)<0 S VAQRES=VAQLMT
66 QUIT
67 ;
68DISDEMO ; -- Displays the entries requiring manual process
69 S VAQECNT=VAQECNT+1
70 S X=$$SETSTR^VALM1("Entry # : "_VAQECNT,"",1,39)
71 S X=$$SETSTR^VALM1(" Trans #: "_VAQTRNO,X,40,39) D TMP
72 S X=$$SETSTR^VALM1("Patient : "_VAQPTNM,"",1,39)
73 S X=$$SETSTR^VALM1("Date/Time: "_DATETIME,X,40,39) D TMP
74 I VAQPTID="" D
75 .S VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)
76 .S X=$$SETSTR^VALM1("Patient SS: "_VAQESSN,"",1,39)
77 S:VAQPTID'="" X=$$SETSTR^VALM1("Patient ID: "_VAQPTID,"",1,39)
78 S X=$$SETSTR^VALM1(" DOB: "_VAQEDOB,X,40,39) D TMP
79 S X=$$SETSTR^VALM1("Domain : "_VAQDOM,"",1,39)
80 S X=$$SETSTR^VALM1(" Reason: "_$P(VAQRES,U,2),X,40,39) D TMP
81 QUIT
82 ;
83DISSEG ; -- Displays selected segments
84 F K=0:0 S K=$O(SEGMENT($J,K)) Q:K="" D
85 .S SEGMENT=SEGMENT($J,K)
86 .I K=1 S X=$$SETSTR^VALM1("Segments : "_SEGMENT,"",1,80) D TMP
87 .I K'=1 S X=$$SETSTR^VALM1(" : "_SEGMENT,"",1,80) D TMP
88 QUIT
89 ;
90TMP ; -- Set the array used by list processor
91 S VALMCNT=VALMCNT+1
92 S ^TMP("VAQR3",$J,VALMCNT,0)=$E(X,1,79)
93 S ^TMP("VAQR3",$J,"IDX",VALMCNT,VAQECNT)=""
94 S ^TMP("VAQR3","VAQIDX",$J,VAQECNT)=VALMCNT_"^"_VAQTRNO
95 Q
96 ;
97HD ; -- Make header line for list processor
98 S VALMHDR(1)="PDX Activity Requiring Manual Processing"
99 QUIT
100 ;
101EXIT ; -- Task entries for batch processing, Cleans up variables
102 I $D(VAQTRN) D TASK^VAQEXT04
103 ;
104 K ^TMP("VAQR3",$J),^TMP("VAQR3","VAQIDX",$J)
105 K STATPT,TRDE,NODE,ND,X,Y,K,J,DATETIME,SEGMENT,SEGDE,SEG,SDI,VALMY,SDAT
106 K VAQECNT,VAQTRNO,VAQPTNM,VAQISSN,VAQIDOB,VAQEDOB,VAQPTID,VAQAUST
107 K VAQAUADD,VAQRES,VAQTRDE,VAQDFN,VAQDOM,VAQSIG,VAQTRN
108 K VAQFLAG,VAQTDTE,VAQESSN,VAQLMT
109 K RELPTR,VAQCST,VAQRST
110 Q
111 ;
112END ; -- End of code
113 QUIT
Note: See TracBrowser for help on using the repository browser.