source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFDBS.m@ 623

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

initial load of WorldVistAEHR

File size: 3.5 KB
RevLine 
[613]1IBDFDBS ;ALB/RMO/CJM - Database Server Utilities; [ 03/23/95 11:08 AM ]
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**38**;APR 24, 1997
3 ;
4 ; These API's were originally copied from routine DGENDBS and use the
5 ; FileMan database server calls (with wrappers around them to facilitate
6 ; their use) to add a new record, update an existing record, and
7 ; validate data in a record.
8 ;
9 ;
10UPD(FILE,IBDFDA,DATA,ERROR) ;File data into an existing record.
11 ; Input:
12 ; FILE - File or sub-file number
13 ; IBDFDA - New name for traditional DA array, with same meaning.
14 ; Pass by reference.
15 ; DATA - Data array to file (pass by reference)
16 ; Format: DATA(<field #>)=<value>
17 ;
18 ; Output:
19 ; Function Value - 0=error and 1=no error
20 ; ERROR - optional error message - if needed, pass by reference
21 ;
22 ; Example: To update a record in subfile 2.0361 in record with ien=353,
23 ; subrecord ien=68, with the field .01 value = 21:
24 ; S DATA(.01)=21,IBDFDA=68,IBDFDA(1)=353 I $$UPD^IBDFDBS(2.0361,.IBDFDA,.DATA,.ERROR) W !,"DONE"
25 ;
26 N FDA,FIELD,IENS,ERRORS
27 ;
28 ;IENS - Internal Entry Number String defined by FM
29 ;FDA - the FDA array as defined by FM
30 ;
31 I '$G(IBDFDA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q 0
32 S IENS=$$IENS^DILF(.IBDFDA)
33 S FIELD=0
34 F S FIELD=$O(DATA(FIELD)) Q:'FIELD D
35 .S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
36 D FILE^DIE("K","FDA","ERRORS(1)")
37 I +$G(DIERR) D
38 .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
39 E D
40 .S ERROR=""
41 ;
42 I $S(+$G(DIERR):0,1:1) D CLEAN^DILF Q 1
43 E D CLEAN^DILF Q 0
44 ;
45ADD(FILE,IBDFDA,DATA,ERROR,IEN) ;
46 ;Description: Creates a new record and files the data.
47 ; Input:
48 ; FILE - File or sub-file number
49 ; IBDFDA - New name for traditional FileMan DA array with same
50 ; meaning. Pass by reference. Only needed if adding to a
51 ; subfile.
52 ; DATA - Data array to file, pass by reference
53 ; Format: DATA(<field #>)=<value>
54 ; IEN - internal entry number to use (optional)
55 ;
56 ; Output:
57 ; Function Value - If no error then it returns the ien of the created record, else returns NULL.
58 ; IBDFDA - returns the ien of the new record, NULL if none created. If needed, pass by reference.
59 ; ERROR - optional error message - if needed, pass by reference
60 ;
61 ; Example: To add a record in subfile 2.0361 in the record with ien=353
62 ; with the field .01 value = 21:
63 ; S DATA(.01)=21,IBDFDA(1)=353 I $$ADD^IBDFDBS(2.0361,.IBDFDA,.DATA) W !,"DONE"
64 ;
65 ; Example: If creating a record not in a subfile, would look like this:
66 ; S DATA(.01)=21 I $$ADD^IBDFDBS(867,,.DATA) W !,"DONE"
67 ;
68 N FDA,FIELD,IENA,IENS,ERRORS
69 ;
70 ;IENS - Internal Entry Number String defined by FM
71 ;IENA - the Internal Entry Numebr Array defined by FM
72 ;FDA - the FDA array defined by FM
73 ;IEN - the ien of the new record
74 ;
75 S IBDFDA="+1"
76 S IENS=$$IENS^DILF(.IBDFDA)
77 S FIELD=0
78 F S FIELD=$O(DATA(FIELD)) Q:'FIELD D
79 .S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
80 I $G(IEN) S IENA(1)=IEN
81 D UPDATE^DIE("","FDA","IENA","ERRORS(1)")
82 I +$G(DIERR) D
83 .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
84 .S IEN=""
85 E D
86 .S IEN=IENA(1)
87 .S ERROR=""
88 D CLEAN^DILF
89 S IBDFDA=IEN
90 Q IEN
91 ;
92TESTVAL(FILE,FIELD,VALUE) ;
93 ;Description: returns 1 if VALUE is a valid value for FIELD in FILE
94 ;
95 Q:(('$G(FILE))!('$G(FIELD))) 0
96 ;
97 N DISPLAY,VALID,RESULT
98 S VALID=1
99 ;
100 ;if there is no external value then it is not valid
101 S DISPLAY=$$EXTERNAL^DILFD(FILE,FIELD,"F",VALUE)
102 I (DISPLAY="") S VALID=0
103 ;
104 I VALID,$$GET1^DID(FILE,FIELD,"","TYPE")'["POINTER" D
105 .D CHK^DIE(FILE,FIELD,,VALUE,.RESULT) I RESULT="^" S VALID=0 Q
106 Q VALID
Note: See TracBrowser for help on using the repository browser.