source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQREQ01.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1VAQREQ01 ;ALB/JFP - PDX, REQUEST PATIENT DATA, STATUS SCREEN;01MAR93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3EP ; -- Main entry point for the list processor
4 K XQORS,VALMEVL
5 D EN^VALM("VAQ STATUS PDX1")
6 QUIT
7 ;
8INIT ; -- Builds array of PDX transactions for the patient entered (SSN) or name
9 K ^TMP("VAQR1",$J),^TMP("VAQIDX",$J)
10 S TRDE="",(VAQECNT,VALMCNT)=0
11 I (VAQISSN="")&(VAQNM="") D QUIT
12 .S TRNO=0,X=$$SETSTR^VALM1(" ","",1,79) D TMP
13 .S X=$$SETSTR^VALM1(" ** Insufficient Information for Patient Look-up...","",1,80) D TMP
14 F S TRDE=$O(^VAT(394.61,$S(VAQISSN'="":"SSN",1:"NAME"),$S(VAQISSN'="":VAQISSN,1:VAQNM),TRDE)) Q:TRDE="" D SETD
15 I VAQECNT=0 D
16 .S TRNO=0,X=$$SETSTR^VALM1(" ","",1,79) D TMP
17 .S X=$$SETSTR^VALM1(" ** No PDX transactions found for this patient... ","",1,80) D TMP
18 QUIT
19 ;
20SETD ; -- Set data for display in list processor
21 F ND=0,"RQST1","RQST2","ATHR1","ATHR2" S NODE(ND)=$G(^VAT(394.61,TRDE,ND))
22 ; -- Filters out transactions marked as purged OR excides life cap
23 S VAQFLAG=$$EXPTRN^VAQUTL97(TRDE) ; -- naked set at SETD+1
24 Q:VAQFLAG=1
25 ;
26 S TRNO=$P(NODE(0),U,1)
27 S STDE=$P(NODE(0),U,2)
28 S STATUS=$S(STDE'="":$P($G(^VAT(394.85,STDE,0)),U,2),1:" ")
29 S VAQTDTE=$P(NODE("ATHR1"),U,1) ; -- response
30 I VAQTDTE'="" S Y=VAQTDTE X ^DD("DD") S DATETIME=Y_" (Rs)"
31 I VAQTDTE="" S (Y,VAQTDTE)=$P(NODE("RQST1"),U,1) X ^DD("DD") S DATETIME=Y_" (Rq)"
32 ;
33 S DOMKEY=$$DOMKEY^VAQUTL94(STDE)
34 S:DOMKEY=-1 DOMAIN="Error extracting domain"
35 S:DOMKEY="R" DOMAIN=$P(NODE("RQST2"),U,1)
36 S:DOMKEY="A" DOMAIN=$P(NODE("ATHR2"),U,1)
37 S VAQECNT=VAQECNT+1 W:(VAQECNT#10)=0 "."
38 D:$D(^VAT(394.61,TRDE,"SEG",0)) SEG^VAQEXT06 ; -- gather segments
39 ;
40 S X=$$SETSTR^VALM1("Entry # : "_VAQECNT,"",1,30)
41 S X=$$SETSTR^VALM1("Trans # : "_TRNO,X,58,21) D TMP
42 S X=$$SETSTR^VALM1("Date/Time: "_DATETIME,"",1,80) D TMP
43 S X=$$SETSTR^VALM1("Domain : "_DOMAIN,"",1,80) D TMP
44 S X=$$SETSTR^VALM1("Status : "_STATUS,"",1,80) D TMP
45 F K=0:0 S K=$O(SEGMENT($J,K)) Q:K="" D
46 .S SEGMENT=SEGMENT($J,K)
47 .I K=1 S X=$$SETSTR^VALM1("Segments : "_SEGMENT,"",1,80) D TMP
48 .I K'=1 S X=$$SETSTR^VALM1(" : "_SEGMENT,"",1,80) D TMP
49 S X=$$SETSTR^VALM1(" ","",1,80) D TMP ; -- null line
50 QUIT
51 ;
52TMP ; -- Set the array used by list processor
53 S VALMCNT=VALMCNT+1
54 S ^TMP("VAQR1",$J,VALMCNT,0)=$E(X,1,79)
55 S ^TMP("VAQR1",$J,"IDX",VALMCNT,VAQECNT)=""
56 S ^TMP("VAQIDX",$J,VAQECNT)=VALMCNT_"^"_TRNO
57 Q
58 ;
59HD ; -- Make header line for list processor
60 S SP50=$J("",50)
61 S VALMHDR(1)="Patient : "_$E(VAQNM_SP50,1,38)_"Type: "_VAQEELG
62 S VALMHDR(2)="Patient SSN: "_$E(VAQESSN_SP50,1,39)_"DOB: "_VAQEDOB
63 QUIT
64 ;
65DIS ; -- Display PDX data
66 N VALMY,SDI,SDAT,VAQRSLT,VAQUNSOL,VAQTRN,VAQBCK
67 D STATPTR^VAQUTL95
68 S VAQBCK=1
69 D EN^VALM2($G(XQORNOD(0)),"S")
70 Q:'$D(VALMY)
71 S SDI=""
72 S SDI=$O(VALMY(SDI)) Q:SDI=""
73 S SDAT=$G(^TMP("VAQIDX",$J,SDI))
74 S VAQTRN=$P(SDAT,U,2),DFN=""
75 S (VAQDFN,DFN)=$O(^VAT(394.61,"B",VAQTRN,DFN))
76 I $P($G(^VAT(394.61,DFN,0)),U,4)=1 D WORKLD^VAQDIS11
77 I ($P($G(^VAT(394.61,DFN,0)),U,2)'=VAQRSLT)&($P($G(^VAT(394.61,DFN,0)),U,2)'=VAQUNSOL) D QUIT
78 .W !," NO Results for transaction selected"
79 .D PAUSE^VAQUTL95
80 .S VALMBCK="R"
81 D EP^VAQDIS15 ; -- Display segments
82 I VAQBCK=1 K VALMBCK QUIT
83 D INIT
84 S VALMBCK="R"
85 QUIT
86 ;
87EXIT ; -- Note: The list processor cleans up its own variables.
88 ; All other variables cleaned up here.
89 ;
90 K ^TMP("VAQR1",$J),^TMP("VAQIDX",$J)
91 K DIC,DIR,NODE,DOMAIN,SEGMENT,SEGMENT($J)
92 K TRDE,TRNO,ND,STDE,STATUS,DATETIME,SEGDE,SEG,SP50,VAQECNT,X,K,J
93 K VAQFLAG,VAQTDTE,DOMKEY
94 Q
95 ;
96END ; -- End of code
97 QUIT
Note: See TracBrowser for help on using the repository browser.