1 | VAQLED10 ;ALB/JFP - LOAD/EDIT PDX RECORD, PROMPT PDX;01APR93
|
---|
2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
---|
3 | INIT ; -- Intialization
|
---|
4 | D ^VAQUTL98
|
---|
5 | ;
|
---|
6 | N POP,DFN
|
---|
7 | ;
|
---|
8 | S:'$D(VAQOPT) VAQOPT="" ; -- should be set from menu option
|
---|
9 | MAIN ; -- Main entry point
|
---|
10 | K POP,DFN,X,Y,ND,NODE
|
---|
11 | K BADSSN,FLE,FLD ; -- table entries
|
---|
12 | K DIROUT,DIRUT,DTOUT,DUOUT
|
---|
13 | K VAQIN,VAQDFN,VAQPTNM,VAQISSN,VAQIDOB,VAQEDOB,VAQPTID,VAQESSN
|
---|
14 | S POP=0
|
---|
15 | ;
|
---|
16 | ; -- Call to Dir to request patient from patient file (2)
|
---|
17 | S DIR("A")="Identify PDX: "
|
---|
18 | S DIR(0)="FAO^1:30^K:(X'=$C(32)&($L(X)<3)) X"
|
---|
19 | S DIR("?")="Enter Patient's Name (Last,First Middle) or SSN or Transaction #"
|
---|
20 | S DIR("??")="^D HLPTRN1^VAQLED09"
|
---|
21 | W !! D ^DIR K DIR G:$D(DIRUT) EXIT
|
---|
22 | S (X,VAQIN)=Y
|
---|
23 | ;
|
---|
24 | ; -- Function call to get patient from transaction file (DIC)
|
---|
25 | S VAQDFN=$$GETTRN^VAQUTL96(X)
|
---|
26 | D:VAQDFN=-1 PTNFND ; -- patient not in transaction file
|
---|
27 | G:POP MLOOP
|
---|
28 | D:VAQDFN>0 HEADER ; -- builds variables for header
|
---|
29 | D EP^VAQLED01 ; -- Call to list processor (status screen)
|
---|
30 | MLOOP G MAIN ; -- loop back until no more patient added
|
---|
31 | ;
|
---|
32 | PTNFND ; -- Requested PDX not found
|
---|
33 | W !,"Patient not found in PDX transaction file..."
|
---|
34 | S POP=1
|
---|
35 | QUIT
|
---|
36 | ;
|
---|
37 | HEADER ; -- Extracts elements for header
|
---|
38 | ;W !,"VAQDFN = ",VAQDFN
|
---|
39 | F ND=0,"QRY" S NODE(ND)=$G(^VAT(394.61,+VAQDFN,ND))
|
---|
40 | S VAQPTNM=$P(NODE("QRY"),U,1),VAQISSN=$P(NODE("QRY"),U,2)
|
---|
41 | S VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)
|
---|
42 | S VAQIDOB=$P(NODE("QRY"),U,3),VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)
|
---|
43 | S VAQPTID=$P(NODE("QRY"),U,4)
|
---|
44 | QUIT
|
---|
45 | ;
|
---|
46 | EXIT ; -- Cleanup and exit routine
|
---|
47 | K POP,DFN,X,Y,ND,NODE
|
---|
48 | K BADSSN,FLE,FLD ; -- table entries
|
---|
49 | K DIROUT,DIRUT,DTOUT,DUOUT
|
---|
50 | K VAQIN,VAQDFN,VAQPTNM,VAQISSN,VAQIDOB,VAQEDOB,VAQPTID,VAQOPT,VAQESSN
|
---|
51 | QUIT
|
---|
52 | ;
|
---|
53 | END ; -- End of code
|
---|
54 | QUIT
|
---|