source: WorldVistAEHR/trunk/r/VISTA_OFFICE_EHR-VEPE/VEPERI7.m@ 949

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

initial load of WorldVistAEHR

File size: 3.1 KB
RevLine 
[613]1VEPERI7 ;DAOU/WCJ - Incoming HL7 messages ;2-MAY-2005
2 ;;1.0;VOEB;;Jun 12, 2005
3 ;;;VISTA OFFICE/EHR;
4 ;;Per VHA Directive 10-93-142, this routine should not be modified.
5 ;
6 ;**Program Description**
7 ; Process patients from the pending file
8 ; New patients were put in a holding file until the user acts on them.
9 ; This is where the user acts on them.
10 Q
11 ;
12EN ;
13 ;
14 N DIC,DIR,IEN,TAG,X,Y,RESULT,I,ADD,DFN,IENS,DA,IENS
15 N DIE,DR,PATIENT,NAME,DOB,SEX,FID
16 ;
17 ; Look up record in holding file
18 ;
19 S DIC=19904.21,DIC(0)="AEQMZ"
20 S DIC("S")="I $P(^(0),U,10)="""",$P(^(0),U,11)="""""
21 S DIC("A")="Enter Patient Name (LAST,FIRST) or Billing System ID: "
22 D ^DIC
23 Q:Y<0
24 S IEN=+Y,NAME=$P(Y(0),U,2),DOB=$P(Y(0),U,3),SEX=$P(Y(0),U,4),FID=$P(Y(0),U,6)
25 ;
26 ; Ask what do do
27 ;
28 S DIR(0)="S^N:NEW;E:EXISTING;R:REJECT"
29 S DIR("A")="PATIENT TYPE "
30 S DIR("B")="N"
31 D ^DIR
32 Q:X=""
33 ;
34 ; Get more info is needed for the various actions
35 ;
36 S TAG=$S(X="N":"NEW",X="E":"EXIST",X="R":"REJECT",1:"")
37 Q:TAG=""
38 D @TAG
39 I '$G(ADD),$G(DFN)<0 Q
40 ;
41 ; See if there are any others like this one
42 ;
43 S IENS=$$OTHERS()
44 Q:'IENS
45 ;
46 ; At this point, I have all the IEN's for this patient, the DFN
47 ; if it's an existing patient, or a flag saying it is new.
48 ;
49 D PENDING^VEPERI0($G(IENS),.DFN)
50 ;
51 ; If no DFN, then this was the first occurance of a new patient and there was
52 ; an error. It is no longer a pending add so reject it.
53 ;
54 I '$G(DFN) S IEN=$P(IENS,",") D REJECT Q
55 ;
56 F I=1:1 S IEN=$P(IENS,",") Q:IEN="" D STAMPDFN
57 Q
58 ;
59 ; New Patient, make sure
60 ;
61NEW S ADD=0
62 S DIR(0)="S^Y:YES;N:NO"
63 S DIR("A")="OK TO ADD "
64 S DIR("B")="Y"
65 D ^DIR
66 I X="Y" S ADD=1
67 Q
68 ;
69 ; This patient was picked as an existing patient
70 ; since the lookup rotuine couldn't figure it out, the user needs to link them.
71 ;
72EXIST ;
73 N ENAME,ESEX,EDOB,EFID
74 S DFN=0
75 S DIC=2
76 S DIC(0)="AEQMVZ"
77 S DIC("A")="Which existing patient ? "
78 D ^DIC
79 I Y<0 Q
80 S PATIENT=+Y
81 S ENAME=$P(Y(0),U,1)
82 S ESEX=$P(Y(0),U,2)
83 S EDOB=$P(Y(0),U,3)
84 S EFID=$$GET1^DIQ(9000001,+Y_",",19907)
85 W !!,"INTERFACE",?20,"VOE SYSTEM"
86 W !,NAME,?20,ENAME
87 W !,SEX,?20,ESEX
88 W !,DOB,?20,EDOB
89 W !,FID,?20,EFID,!!
90 S DIR(0)="S^Y:YES;N:NO"
91 S DIR("A")="OK TO FILE "
92 D ^DIR
93 I X="Y" S DFN=PATIENT
94 Q
95 ;
96 ; Either a user rejected this or it errored upon processing
97REJECT ;
98 S DIE=19904.21,DR=".1///NOW",DA=IEN
99 D ^DIE
100 Q
101 ;
102 ; Stamp the record with the patient that is was matched with
103STAMPDFN ;
104 S DIE=19904.21,DR=".11///^S X=DFN",DA=IEN
105 D ^DIE
106 Q
107 ;
108 ; Look for mulitple occurrances of this patientfor them all to be processed
109 ; return a string of IENS from file 772 (the pointed to file)
110OTHERS() ;
111 N IENS,SCREEN,RESULT
112 S SCREEN="I $P(^(0),U,10)="""",$P(^(0),U,11)="""",$P(^(0),U,3)=DOB,$P(^(0),U,4)=SEX,$P(^(0),U,6)=FID"
113 D FIND^DIC(19904.21,,,"CMO",NAME,"CD",,SCREEN,,"RESULT","ERR")
114 I '+$G(RESULT("DILIST",0)) Q 0
115 S IENS=""
116 F I=1:1 Q:'$D(RESULT("DILIST",1,I)) S IENS=IENS_RESULT("DILIST",1,I)_$S($D(RESULT("DILIST",2,I+1)):",",1:"")
117 Q IENS
118 ;
119 ; simple report of patients awaiting action
120REPORT ;
121 N DIC,FLDS,BY,L
122 S DIC=19904.21,FLDS="[NEW PATIENTS]",BY="[NEW PATIENTS]",L=0
123 D EN1^DIP
124 Q
Note: See TracBrowser for help on using the repository browser.