source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQREQ10.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 3.4 KB
Line 
1VAQREQ10 ;ALB/JFP - REQUEST PDX RECORD, PROMPT PATIENT;01MAR93
2 ;;1.5;PATIENT DATA EXCHANGE;**25**;NOV 17, 1993
3 ; -- Entry Points
4REQ D KILL^XUSCLEAN S VAQOPT="REQ" G INIT
5UNS D KILL^XUSCLEAN S VAQOPT="UNS" G INIT
6 QUIT
7INIT ; -- Intialization
8 D ^VAQUTL98
9 N POP,TASK,DFN
10 S:'$D(VAQOPT) VAQOPT="" ; -- should be set from entry point
11 ;
12MAIN ; -- Main entry point
13 K VAQDFN,VAQIN,VAQNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQIELG,VAQEELG
14 K VAQAUSIT,VAQDOM,VAQDZ,VAQNOTI,VAQPID,VAQRQADD,VAQRQDT,VAQRQSIT
15 K VAQTRN,VAQDZN,VAQPR,DFN
16 S POP=0
17 ;
18 ; -- Call to Dir to request patient from patient file (2)
19 S DIR("A")="Select Patient Name: "
20 S DIR(0)="FAO^1:30^S X=$$UP^XLFSTR(X) K:(X'=$C(32)&($L(X)<1)) X"
21 S DIR("?")="Enter Patient's Name (Last,First Middle) or SSN"
22 W !! D ^DIR K DIR G:$D(DIRUT) EXIT
23 S VAQIN=$$UP^XLFSTR(Y)
24 ;
25 ; -- Function call to get patient DFN (DIC)
26 S TASK=$D(ZTSK) ; -- task = 1 (batch), task = 0 interactive
27 D:$D(XRTL) T0^%ZOSV ; -- Capacity start
28 S VAQDFN=$$GETDFN^VAQUTL97(VAQIN,TASK)
29 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop
30 D:VAQDFN=-1 MANUAL ; -- not in patient file (manual request)
31 G:POP MLOOP
32 D:VAQDFN>0 VADPT ; -- pulls off MAS data
33 D EP^VAQREQ01 ; -- Call to list processor (status screen)
34MLOOP G MAIN ; -- loop back until no more patient added
35 ;
36EXIT ; -- Cleanup and exit routine
37 K POP,TASK,DFN
38 K DIROUT,DIRUT,DTOUT,DUOUT,X,Y,BADSSN
39 K VAQDFN,VAQIN,VAQNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQIELG,VAQEELG
40 K VAQAUSIT,VAQDOM,VAQDZ,VAQNOTI,VAQPID,VAQOPT,VAQRQADD,VAQRQDT,VAQRQSIT
41 K VAQTRN,VAQDZN,VAQPR
42 QUIT
43 ;
44MANUAL ; -- Gets Patient name SSN AND DOB if patient not found local PT file
45 ; -- Don't allow manual entry of unsolicited request
46 I VAQOPT="UNS" W !!,"An unsolicited PDX request requires an entry from the patient file...",!,"Press any key to continue: " S POP=1 R X:DTIME QUIT
47 ;
48 ; -- Request data
49 S VAQEELG="Not Available"
50 W !,$C(7)
51 S DIR(0)="Y"
52 S DIR("A")=VAQIN_" not found in local patient file... Request PDX"
53 S DIR("B")="YES"
54 S DIR("?")="You will be required to enter the needed information."
55 S DIR("?",1)="Enter 'YES' to request a PDX for a patient not in your Patient File."
56 D ^DIR K DIR I $D(DIRUT)!('Y) S POP=1 QUIT
57 ;
58 ; -- Request patient name
59 S DIR(0)="FAO^3:30^S X=$$UP^XLFSTR(X) K:(X?1P.E)!(X'?1U.ANP)!(X'["","") X"
60 S DIR("A")=" Patient name : "
61 S DIR("B")=VAQIN
62 S DIR("?")="Enter patient's name in uppercase (LAST,FIRST MIDDLE)"
63 S DIR("??")="^D PAT^VAQREQ09"
64 D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) S POP=1 QUIT
65 S VAQNM=$$UP^XLFSTR(Y)
66 ;
67 ; -- Request pt SSN
68 S DIR(0)="FAO^9:10^K:(X'?9N)&(X'?9N1""P"")!($D(BADSSN(X))) X"
69 S DIR("A")=" SSN : "
70 S DIR("?")="Enter patient's SSN (without dashes)"
71 D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) S POP=1 QUIT
72 S VAQISSN=Y,VAQESSN=$$DASHSSN^VAQUTL99(Y)
73 ;
74 ; -- Checks for name or ssn required
75 I (VAQNM="")&(VAQISSN="") W !!,"Patient name or SSN is required...Press any key to continue: " S POP=1 R X:DTIME QUIT
76 ;
77 ; -- Request pt DOB
78 S DIR(0)="DAO^::EP"
79 S DIR("A")=" DATE OF BIRTH : "
80 S DIR("?")="Enter patient's date of birth"
81 D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) S POP=1 QUIT
82 S VAQIDOB=Y,VAQEDOB=$$DOBFMT^VAQUTL99(Y)
83 QUIT
84 ;
85VADPT ; -- Pulls off patient demographics, for DFN
86 ; -- Gets name,ssn,dob
87 S DFN=$P(VAQDFN,U,1)
88 D DEM^VADPT,ELIG^VADPT
89 S VAQNM=VADM(1)
90 S VAQISSN=$P(VADM(2),U,1),VAQESSN=$P(VADM(2),U,2)
91 S VAQIDOB=$P(VADM(3),U,1),VAQEDOB=$P(VADM(3),U,2)
92 S VAQIELG=$P(VAEL(6),U,1),VAQEELG=$P(VAEL(6),U,2)
93 K VADM,VAEL,VAERR,VA
94 QUIT
95 ;
96END ; -- End of code
97 QUIT
Note: See TracBrowser for help on using the repository browser.