source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQFILE.m@ 1742

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

initial load of WorldVistAEHR
File size: 3.7 KB
Line 
1VAQFILE ;ALB/JRP/KLD - MESSAGE FILING;12-MAY-93 [ 10/04/96 1:10 PM ]
2 ;;1.5;PATIENT DATA EXCHANGE;**22,26,28,32**;NOV 17, 1993
3NEWTRAN() ;MAKE STUB ENTRY IN TRANSACTION FILE
4 ;INPUT : NONE
5 ;OUTPUT : IFN^Transaction_Number - Success
6 ; -1^Error_text - Error
7 ;
8 ;DECLARE VARIABLES
9 N DD,DIC,X,DINUM,Y,DLAYGO
10 S X="+" ;-- auto numbering - see ^DD(394.61,.01,7.5). It involves $$AUTO^VAQXRF2(1) and file 394.86.
11 S DIC="^VAT(394.61,",DIC(0)="L",DLAYGO=394.61
12 D ^DIC
13 I Y<0 Q "-1^Could not determine new transaction number"
14 Q $P(Y,U,1,2)
15 ;
16DELTRAN(TRANPTR) ;DELETE TRANSACTION
17 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
18 ;OUTPUT : 0 - Success
19 ; -1^Error_text - Error
20 ;NOTES : This will also delete all entries in the VAQ - DATA file
21 ; that are associated with the transaction.
22 ;
23 ;CHECK INPUT
24 Q:('(+$G(TRANPTR))) "-1^Did not pass pointer to transaction"
25 ;DECLARE VARIABLES
26 N DIK,SEGMENT,DA,DATAPTR,TMP
27 ;DELETE ENTRIES IN DATA FILE
28 S (DATAPTR,SEGMENT)=""
29 F S SEGMENT=$O(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT)) Q:'SEGMENT D
30 . F S DATAPTR=+$O(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT,DATAPTR)) Q:'DATAPTR D
31 . . I ('$D(^VAT(394.62,DATAPTR,0))&($D(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT,DATAPTR))=1)) D
32 . . . K ^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT,DATAPTR)
33 . . Q:'DATAPTR
34 . . S TMP=$$DELDATA^VAQFILE1(DATAPTR)
35 . . Q:(TMP)
36 ;IF TRANSACTION DOES NOT EXIST RETURN SUCCESS
37 Q:('$D(^VAT(394.61,TRANPTR))) 0
38 ;DELETE ENTRY IN TRANSACTION FILE
39 S DIK="^VAT(394.61,"
40 S DA=TRANPTR
41 D ^DIK
42 Q:($D(^VAT(394.61,TRANPTR))) "-1^Unable to delete transaction"
43 Q 0
44 ;
45FILEINFO(FILE,DA,FIELD,VALUE,SUBFIELD,SUBVALUE) ;FILE INFORMATION
46 ;INPUT : FILE - File number
47 ; DA - IFN of entry to edit
48 ; FIELD - Field number
49 ; VALUE - Information to be filed (defaults to '@')
50 ; SUBFIELD - Field number in multiple
51 ; SUBVALUE - Information to be filed in SUBFIELD of multiple
52 ; (defaults to '@')
53 ;OUTPUT : 0 - Success
54 ; -1^Error_text - Error
55 ;NOTES : If SUBFIELD is not passed, editing of a multiple will be
56 ; ignored. If SUBFIELD is passed, the multiple under VALUE
57 ; will be edited.
58 ; : If working with a multiple, it is the responsibility of
59 ; the calling routine to verify that VALUE can be added as
60 ; an entry in the multiple. It is also the responsibility
61 ; of the calling routine to verify that VALUE is an entry in
62 ; the subfile when deleting/editing.
63 ;
64 ;CHECK INPUT
65 N IFN,NAME,SSN,PID,SITE,DOMAIN
66 Q:('$G(FILE)) "-1^Did not pass file number"
67 Q:('$D(^DD(FILE))) "-1^Did not pass valid file number"
68 Q:('$G(DA)) "-1^Did not pass entry number"
69 Q:('$G(FIELD)) "-1^Did not pass field number"
70 Q:('$D(^DD(FILE,FIELD))) "-1^Did not pass valid field number"
71 S VALUE=$G(VALUE)
72 ;REMOVE ';' FROM VALUE (CONFUSES CALL TO DIE)
73 S VALUE=$TR(VALUE,";","")
74 S:(VALUE="") VALUE="@"
75 S SUBFIELD=+$G(SUBFIELD)
76 S SUBVALUE=$G(SUBVALUE)
77 S:(SUBVALUE="") SUBVALUE="@"
78 ;DECLARE VARIABLES
79 N DIE,DR,Y,X,SUBFILE,ERR
80 S DIE=$G(^DIC(FILE,0,"GL"))
81 Q:(DIE="") "-1^Could not determine global root of file"
82 Q:('$D(@(DIE_DA_")"))) "-1^Did not pass valid entry number"
83 S DR=FIELD_"///"_VALUE
84 ;SET UP FOR MULTIPLE
85 S ERR=0
86 I (SUBFIELD) D Q:(ERR) ERR
87 .S SUBFILE=+$P($G(^DD(FILE,FIELD,0)),"^",2)
88 .I ('SUBFILE) S ERR="-1^Main field is not a multiple" Q
89 .I ('$D(^DD(SUBFILE,SUBFIELD))) S ERR="-1^Did not pass valid field in multiple" Q
90 .S DR(2,SUBFILE)=SUBFIELD_"///"_SUBVALUE
91 ;MAKE SURE OTHER USER ISN'T EDITING ENTRY
92 L +(@(DIE_DA_")")):60 Q:('$T) "-1^Could not edit entry (locked by other user)"
93 D ^DIE
94 L -(@(DIE_DA_")"))
95 Q:($D(Y)#2) "-1^Could not file new value"
96 Q 0
Note: See TracBrowser for help on using the repository browser.