source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQEXT02.m@ 1226

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

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1VAQEXT02 ;ALB/JFP - PDX, PROCESS EXTERNAL (MANUAL),PROCESS SCREEN;01MAR93
2 ;;1.5;PATIENT DATA EXCHANGE;**1,10,14**;NOV 17, 1993
3EP ; -- Main entry point for the list processor
4 ; -- K XQORS,VALMEVL ;(only kill on the first screen in)
5 D EN^VALM("VAQ PROCESS PDX4")
6 N VALMCNT S VALMCNT=0
7 QUIT
8 ;
9INIT ; -- Builds array of Patients based on PDX transactions for manual
10 ; processing
11 ;
12 K ^TMP("VAQR4",$J),^TMP("VAQR4","VAQIDX",$J)
13 N VAQST,VAQFLAG,VAQCMNT,VAQDFN,VAQECNT
14 N VADM,VA,VAERR
15 ;
16 S (VAQECNT,VALMCNT)=0,(VAQDFN,DFN)=""
17 F S DFN=$O(DPTD(DFN)) Q:DFN="" D
18 .S VAQECNT=VAQECNT+1
19 .D DEM^VADPT
20 .S X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
21 .S X=$$SETFLD^VALM1(VADM(1),X,"LOCAL PATIENT NAME")
22 .S X=$$SETFLD^VALM1($P(VADM(2),U,2),X,"SSN")
23 .S VA("DOB")=$$DOBFMT^VAQUTL99($P(VADM(3),U,1))
24 .S X=$$SETFLD^VALM1(VA("DOB"),X,"DOB")
25 .S X=$$SETFLD^VALM1(VA("PID"),X,"PID")
26 .D TMP
27 QUIT
28 ;
29TMP ; -- Set the array used by list processor
30 S VALMCNT=VALMCNT+1
31 S ^TMP("VAQR4",$J,VALMCNT,0)=$E(X,1,79)
32 S ^TMP("VAQR4",$J,"IDX",VALMCNT,VAQECNT)=""
33 S ^TMP("VAQR4","VAQIDX",$J,VAQECNT)=VALMCNT_"^"_VAQTRDE_"^"_DFN
34 Q
35 ;
36HD ; -- Make header line for list processor
37 Q:'$D(VALMY)
38HD1 N X,SP50
39 S SP50=$J("",50)
40 S X=$$SETSTR^VALM1("Remote Patient: "_VAQPTNM,"",1,41)
41 S:VAQPTID="" X=$$SETSTR^VALM1("SSN: "_VAQESSN,X,42,17)
42 S:VAQPTID'="" X=$$SETSTR^VALM1(" ID: "_VAQPTID,X,42,17)
43 S X=$$SETSTR^VALM1(" DOB: "_VAQEDOB,X,59,20)
44 S VALMHDR(1)=" "
45 S VALMHDR(2)=X
46 S VALMHDR(3)=" "
47 QUIT
48 ;
49REJ ; -- Reject PDX with comment
50 S VAQST="REJ",VAQFLAG=0,VAQCMNT="Reject "
51 D CLEAR^VALM1
52 S:'$D(VAQSIG) VAQSIG=$$VRFYUSER^VAQAUT(DUZ) ; -- Signature
53 I VAQSIG<0 K VAQSIG D TRANEX QUIT
54 D EP^VAQREQ08 ; -- Comment for reject
55 D EP^VAQEXT03
56 D TRANEX
57 QUIT
58 ;
59REL ; -- Release PDX with comment
60 D SEL^VALM2
61 Q:'$D(VALMY)
62 N ENT S ENT=$O(VALMY(""))
63 S DFN=$P(^TMP("VAQR4","VAQIDX",$J,ENT),"^",3)
64 S VAQFLAG=0,VAQST="REL",VAQCMNT="Release "
65 D CLEAR^VALM1
66 S:'$D(VAQSIG) VAQSIG=$$VRFYUSER^VAQAUT(DUZ) ; -- Signature
67 I VAQSIG<0 K VAQSIG D TRANEX QUIT
68 D EP^VAQREQ08 ; -- Comment for reject
69 D EP^VAQEXT03 ; --
70 D TRANEX
71 QUIT
72 ;
73NFND ; -- Not found (reject)
74 D CLEAR^VALM1 ;clears screen
75 S DIR(0)="Y",DIR("B")="YES"
76 S DIR("A")="Requested patient not found...Process as not found"
77 D ^DIR K DIR
78 I ('Y)!($D(DUOUT))!($D(DTOUT)) S VALMBCK="Q" QUIT
79 S:'$D(VAQSIG) VAQSIG=$$VRFYUSER^VAQAUT(DUZ) ; -- Signature
80 I VAQSIG<0 K VAQSIG D TRANEX QUIT
81 S:'$D(DFN) DFN=""
82 S VAQST="NFND"
83 D:Y EP^VAQEXT03
84 D TRANEX
85 QUIT
86 ;
87EXP ; -- Expand entry
88 D SEL^VALM2
89 Q:'$D(VALMY)
90 N ENT S ENT=$O(VALMY(""))
91 S DFN=$P(^TMP("VAQR4","VAQIDX",$J,ENT),"^",3)
92 D EP^VAQDIS01
93 S VALMBCK="R"
94 QUIT
95 ;
96TRANEX ; -- Pauses screen
97 D PAUSE^VAQUTL95
98 S:'$D(VAQFLAG) VAQFLAG=""
99 S VALMBCK=$S(VAQFLAG=0:"R",1:"Q")
100 QUIT
101 ;
102EXIT ; -- Note: The list processor cleans up its own variables.
103 ; All other variables cleaned up here.
104 ;
105 K ^TMP("VAQR4",$J),^TMP("VAQR4","VAQIDX",$J)
106 K VAQST,VAQFLAG,VAQCMNT,VAQDFN,VAQECNT
107 K VALMCNT,VADM,SP50,DFN
108 Q
109 ;
110END ; -- End of code
111 QUIT
Note: See TracBrowser for help on using the repository browser.