source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENA1.m@ 1688

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

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1DGENA1 ;ALB/CJM,ISA/KWP - Enrollment API - File Data; 05/05/99
2 ;;5.3;Registration;**121,147,232**;Aug 13,1993
3 ;PHASE II moved CHECK and TESTVAL to DGENA3
4LOCK(DFN) ;
5 ;Description: This lock is used to prevent another process from editing
6 ; a patient's enrollment, including the current enrollment and the
7 ; enrollment history.
8 ;Input:
9 ; DFN - Patient IEN
10 ;Output:
11 ; Function Value - Returns 1 if the lock was successful, 0 otherwise
12 ;
13 I $G(DFN) L +^DPT("ENROLLMENT",DFN):10
14 Q $T
15UNLOCK(DFN) ;
16 ;Description: Used to release a lock created by $$LOCK.
17 ;Input:
18 ; DFN - Patient IEN
19 ;Output: None
20 ;
21 I $G(DFN) L -^DPT("ENROLLMENT",DFN)
22 Q
23STORE(DGENR,NOCHECK,ERRMSG) ;
24 ;Description: Used to file a PATIENT ENROLLMENT record. Consistency
25 ; checks are done unless NOCHECK=1.If the
26 ; enrollment passes the consistency checks specified the
27 ; PATIENT ENROLLMENT record will be created and the ien returned.
28 ; If the consistency checks are not passed, or a record can not
29 ; be created, 0 is returned. This call does NOT lock the record -
30 ; call LOCK prior to STORE if the record needs to be locked.
31 ;Input :
32 ; DGENR - this local array represents a PATIENT ENROLLMENT (pass by reference)
33 ; NOCHECK - a flag, if NOCHECK=1 it means the consistency checks were done already, so do not do them again. (optional)
34 ; ERRMSG - error message on failure (optional, pass by reference)
35 ;Output:
36 ; Function Value - returns the ien of the PATIENT ENROLLMENT record
37 ; created if successful , 0 otherwise
38 N DIC,DA,DIE,Y,DR,DO,DLAYGO,DD
39 ;check that enrollment is valid before storing
40 I $G(NOCHECK)'=1 Q:'$$CHECK^DGENA3(.DGENR,,.ERRMSG) 0
41 ;create a new record
42 S DLAYGO=27.11
43 S DIC(0)="L",X=DGENR("APP"),DIC="^DGEN(27.11,"
44 D FILE^DICN
45 I Y=-1 S ERRMSG="FILEMAN UNABLE TO CREATE ENROLLMENT RECORD" Q 0
46 S DA=+Y
47 ;if failed to store record, exit
48 Q:'DA 0
49 ;edit the record
50 I '$$EDIT^DGENA1A(DA,.DGENR) Q 0
51 Q DA
52STORECUR(DGENR,NOCHECK,ERRMSG) ;
53 ;Description: Used to store an enrollment that has already been created
54 ; as a local array into the PATIENT ENROLLMENT file as the
55 ; patient's current enrollment. If the enrollment passes the
56 ; consistency checks specified the enrollment record will be
57 ; created and the internal entry number returned. If the
58 ; consistency checks are not passed, or a record can not be
59 ; created, 0 will be returned
60 ;Input :
61 ; DGENR - this local array represents a PATIENT ENROLLMENT and should
62 ; be passed by reference.
63 ; NOCHECK - a flag, if NOCHECK=1 it means the consistency checks were done already, so do not do them again. (optional)
64 ;Output:
65 ; Function Value - returns the internal entry number of the PATIENT
66 ; ENROLLMENT record created if successful , 0 otherwise
67 ; ERRMSG - error message on failure (optional, pass by reference)
68 N DGENRIEN,OK
69 S OK=1
70 I '$$LOCK($G(DGENR("DFN"))) S OK=0
71 D:OK
72 .S DGENRIEN=$$STORE(.DGENR,$G(NOCHECK),.ERRMSG)
73 .I 'DGENRIEN S OK=0
74 .D:OK
75 ..N PRIOR
76 ..;link enrollment record to the prior enrollment
77 ..D:DGENR("PRIORREC") KILL^DGENA1A(27.11,DGENRIEN,.09,DGENR("PRIORREC"))
78 ..S PRIOR=$$FINDCUR^DGENA(DGENR("DFN"))
79 ..S $P(^DGEN(27.11,DGENRIEN,0),"^",9)=PRIOR
80 ..D:PRIOR SET^DGENA1A(27.11,DGENRIEN,.09,PRIOR)
81 ..;now link the patient record to the new current enrollment
82 ..D:PRIOR KILL^DGENA1A(2,DGENR("DFN"),27.01,PRIOR)
83 ..S $P(^DPT(DGENR("DFN"),"ENR"),"^")=DGENRIEN
84 ..D SET^DGENA1A(2,DGENR("DFN"),27.01,DGENRIEN)
85 D UNLOCK(DGENR("DFN"))
86 Q $S(OK:DGENRIEN,1:0)
87EDITCUR(DGENR) ;
88 ;Description: Used to store an enrollment that has already been created
89 ; as a local array into the PATIENT ENROLLMENT file as the
90 ; patient's current enrollment. If the enrollment passes the
91 ; consistency checks specified the current enrollment record, if
92 ; it exists, will be overlaid by the enrollment contained in
93 ; DGENR, otherwise, if there is no current enrollment, a new
94 ; patient enrollment record will be created as the current
95 ; enrollment. If the consistency checks are not passed, or a
96 ; record can not be created, NULL will be returned.
97 ;Input :
98 ; DGENR - this local array represents a PATIENT ENROLLMENT and
99 ; should be passed by reference.
100 ;Output:
101 ; Function Value - returns the internal entry number of the PATIENT
102 ; ENROLLMENT record created if successful , 0 otherwise
103 N DGENRIEN,OK
104 S OK=$$LOCK($G(DGENR("DFN")))
105 D:OK
106 .S DGENRIEN=$$FINDCUR^DGENA(DGENR("DFN"))
107 .I 'DGENRIEN D
108 ..S OK=$$STORECUR(.DGENR)
109 .E D
110 ..S OK=$$CHECK^DGENA3(.DGENR)
111 ..I OK S OK=$$EDIT^DGENA1A(DGENRIEN,.DGENR)
112 D UNLOCK(DGENR("DFN"))
113 Q $S(OK:DGENRIEN,1:0)
Note: See TracBrowser for help on using the repository browser.