VAQFILE ;ALB/JRP/KLD - MESSAGE FILING;12-MAY-93 [ 10/04/96 1:10 PM ]
;;1.5;PATIENT DATA EXCHANGE;**22,26,28,32**;NOV 17, 1993
NEWTRAN() ;MAKE STUB ENTRY IN TRANSACTION FILE
;INPUT : NONE
;OUTPUT : IFN^Transaction_Number - Success
; -1^Error_text - Error
;
;DECLARE VARIABLES
N DD,DIC,X,DINUM,Y,DLAYGO
S X="+" ;-- auto numbering - see ^DD(394.61,.01,7.5). It involves $$AUTO^VAQXRF2(1) and file 394.86.
S DIC="^VAT(394.61,",DIC(0)="L",DLAYGO=394.61
D ^DIC
I Y<0 Q "-1^Could not determine new transaction number"
Q $P(Y,U,1,2)
;
DELTRAN(TRANPTR) ;DELETE TRANSACTION
;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
;OUTPUT : 0 - Success
; -1^Error_text - Error
;NOTES : This will also delete all entries in the VAQ - DATA file
; that are associated with the transaction.
;
;CHECK INPUT
Q:('(+$G(TRANPTR))) "-1^Did not pass pointer to transaction"
;DECLARE VARIABLES
N DIK,SEGMENT,DA,DATAPTR,TMP
;DELETE ENTRIES IN DATA FILE
S (DATAPTR,SEGMENT)=""
F S SEGMENT=$O(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT)) Q:'SEGMENT D
. F S DATAPTR=+$O(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT,DATAPTR)) Q:'DATAPTR D
. . I ('$D(^VAT(394.62,DATAPTR,0))&($D(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT,DATAPTR))=1)) D
. . . K ^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT,DATAPTR)
. . Q:'DATAPTR
. . S TMP=$$DELDATA^VAQFILE1(DATAPTR)
. . Q:(TMP)
;IF TRANSACTION DOES NOT EXIST RETURN SUCCESS
Q:('$D(^VAT(394.61,TRANPTR))) 0
;DELETE ENTRY IN TRANSACTION FILE
S DIK="^VAT(394.61,"
S DA=TRANPTR
D ^DIK
Q:($D(^VAT(394.61,TRANPTR))) "-1^Unable to delete transaction"
Q 0
;
FILEINFO(FILE,DA,FIELD,VALUE,SUBFIELD,SUBVALUE) ;FILE INFORMATION
;INPUT : FILE - File number
; DA - IFN of entry to edit
; FIELD - Field number
; VALUE - Information to be filed (defaults to '@')
; SUBFIELD - Field number in multiple
; SUBVALUE - Information to be filed in SUBFIELD of multiple
; (defaults to '@')
;OUTPUT : 0 - Success
; -1^Error_text - Error
;NOTES : If SUBFIELD is not passed, editing of a multiple will be
; ignored. If SUBFIELD is passed, the multiple under VALUE
; will be edited.
; : If working with a multiple, it is the responsibility of
; the calling routine to verify that VALUE can be added as
; an entry in the multiple. It is also the responsibility
; of the calling routine to verify that VALUE is an entry in
; the subfile when deleting/editing.
;
;CHECK INPUT
N IFN,NAME,SSN,PID,SITE,DOMAIN
Q:('$G(FILE)) "-1^Did not pass file number"
Q:('$D(^DD(FILE))) "-1^Did not pass valid file number"
Q:('$G(DA)) "-1^Did not pass entry number"
Q:('$G(FIELD)) "-1^Did not pass field number"
Q:('$D(^DD(FILE,FIELD))) "-1^Did not pass valid field number"
S VALUE=$G(VALUE)
;REMOVE ';' FROM VALUE (CONFUSES CALL TO DIE)
S VALUE=$TR(VALUE,";","")
S:(VALUE="") VALUE="@"
S SUBFIELD=+$G(SUBFIELD)
S SUBVALUE=$G(SUBVALUE)
S:(SUBVALUE="") SUBVALUE="@"
;DECLARE VARIABLES
N DIE,DR,Y,X,SUBFILE,ERR
S DIE=$G(^DIC(FILE,0,"GL"))
Q:(DIE="") "-1^Could not determine global root of file"
Q:('$D(@(DIE_DA_")"))) "-1^Did not pass valid entry number"
S DR=FIELD_"///"_VALUE
;SET UP FOR MULTIPLE
S ERR=0
I (SUBFIELD) D Q:(ERR) ERR
.S SUBFILE=+$P($G(^DD(FILE,FIELD,0)),"^",2)
.I ('SUBFILE) S ERR="-1^Main field is not a multiple" Q
.I ('$D(^DD(SUBFILE,SUBFIELD))) S ERR="-1^Did not pass valid field in multiple" Q
.S DR(2,SUBFILE)=SUBFIELD_"///"_SUBVALUE
;MAKE SURE OTHER USER ISN'T EDITING ENTRY
L +(@(DIE_DA_")")):60 Q:('$T) "-1^Could not edit entry (locked by other user)"
D ^DIE
L -(@(DIE_DA_")"))
Q:($D(Y)#2) "-1^Could not file new value"
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQFILE 3834 printed Sep 23, 2025@20:01:33 Page 2
VAQFILE ;ALB/JRP/KLD - MESSAGE FILING;12-MAY-93 [ 10/04/96 1:10 PM ]
+1 ;;1.5;PATIENT DATA EXCHANGE;**22,26,28,32**;NOV 17, 1993
NEWTRAN() ;MAKE STUB ENTRY IN TRANSACTION FILE
+1 ;INPUT : NONE
+2 ;OUTPUT : IFN^Transaction_Number - Success
+3 ; -1^Error_text - Error
+4 ;
+5 ;DECLARE VARIABLES
+6 NEW DD,DIC,X,DINUM,Y,DLAYGO
+7 ;-- auto numbering - see ^DD(394.61,.01,7.5). It involves $$AUTO^VAQXRF2(1) and file 394.86.
SET X="+"
+8 SET DIC="^VAT(394.61,"
SET DIC(0)="L"
SET DLAYGO=394.61
+9 DO ^DIC
+10 IF Y<0
QUIT "-1^Could not determine new transaction number"
+11 QUIT $PIECE(Y,U,1,2)
+12 ;
DELTRAN(TRANPTR) ;DELETE TRANSACTION
+1 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
+2 ;OUTPUT : 0 - Success
+3 ; -1^Error_text - Error
+4 ;NOTES : This will also delete all entries in the VAQ - DATA file
+5 ; that are associated with the transaction.
+6 ;
+7 ;CHECK INPUT
+8 if ('(+$GET(TRANPTR)))
QUIT "-1^Did not pass pointer to transaction"
+9 ;DECLARE VARIABLES
+10 NEW DIK,SEGMENT,DA,DATAPTR,TMP
+11 ;DELETE ENTRIES IN DATA FILE
+12 SET (DATAPTR,SEGMENT)=""
+13 FOR
SET SEGMENT=$ORDER(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT))
if 'SEGMENT
QUIT
Begin DoDot:1
+14 FOR
SET DATAPTR=+$ORDER(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT,DATAPTR))
if 'DATAPTR
QUIT
Begin DoDot:2
+15 IF ('$DATA(^VAT(394.62,DATAPTR,0))&($DATA(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT,DATAPTR))=1))
Begin DoDot:3
+16 KILL ^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT,DATAPTR)
End DoDot:3
+17 if 'DATAPTR
QUIT
+18 SET TMP=$$DELDATA^VAQFILE1(DATAPTR)
+19 if (TMP)
QUIT
End DoDot:2
End DoDot:1
+20 ;IF TRANSACTION DOES NOT EXIST RETURN SUCCESS
+21 if ('$DATA(^VAT(394.61,TRANPTR)))
QUIT 0
+22 ;DELETE ENTRY IN TRANSACTION FILE
+23 SET DIK="^VAT(394.61,"
+24 SET DA=TRANPTR
+25 DO ^DIK
+26 if ($DATA(^VAT(394.61,TRANPTR)))
QUIT "-1^Unable to delete transaction"
+27 QUIT 0
+28 ;
FILEINFO(FILE,DA,FIELD,VALUE,SUBFIELD,SUBVALUE) ;FILE INFORMATION
+1 ;INPUT : FILE - File number
+2 ; DA - IFN of entry to edit
+3 ; FIELD - Field number
+4 ; VALUE - Information to be filed (defaults to '@')
+5 ; SUBFIELD - Field number in multiple
+6 ; SUBVALUE - Information to be filed in SUBFIELD of multiple
+7 ; (defaults to '@')
+8 ;OUTPUT : 0 - Success
+9 ; -1^Error_text - Error
+10 ;NOTES : If SUBFIELD is not passed, editing of a multiple will be
+11 ; ignored. If SUBFIELD is passed, the multiple under VALUE
+12 ; will be edited.
+13 ; : If working with a multiple, it is the responsibility of
+14 ; the calling routine to verify that VALUE can be added as
+15 ; an entry in the multiple. It is also the responsibility
+16 ; of the calling routine to verify that VALUE is an entry in
+17 ; the subfile when deleting/editing.
+18 ;
+19 ;CHECK INPUT
+20 NEW IFN,NAME,SSN,PID,SITE,DOMAIN
+21 if ('$GET(FILE))
QUIT "-1^Did not pass file number"
+22 if ('$DATA(^DD(FILE)))
QUIT "-1^Did not pass valid file number"
+23 if ('$GET(DA))
QUIT "-1^Did not pass entry number"
+24 if ('$GET(FIELD))
QUIT "-1^Did not pass field number"
+25 if ('$DATA(^DD(FILE,FIELD)))
QUIT "-1^Did not pass valid field number"
+26 SET VALUE=$GET(VALUE)
+27 ;REMOVE ';' FROM VALUE (CONFUSES CALL TO DIE)
+28 SET VALUE=$TRANSLATE(VALUE,";","")
+29 if (VALUE="")
SET VALUE="@"
+30 SET SUBFIELD=+$GET(SUBFIELD)
+31 SET SUBVALUE=$GET(SUBVALUE)
+32 if (SUBVALUE="")
SET SUBVALUE="@"
+33 ;DECLARE VARIABLES
+34 NEW DIE,DR,Y,X,SUBFILE,ERR
+35 SET DIE=$GET(^DIC(FILE,0,"GL"))
+36 if (DIE="")
QUIT "-1^Could not determine global root of file"
+37 if ('$DATA(@(DIE_DA_")")))
QUIT "-1^Did not pass valid entry number"
+38 SET DR=FIELD_"///"_VALUE
+39 ;SET UP FOR MULTIPLE
+40 SET ERR=0
+41 IF (SUBFIELD)
Begin DoDot:1
+42 SET SUBFILE=+$PIECE($GET(^DD(FILE,FIELD,0)),"^",2)
+43 IF ('SUBFILE)
SET ERR="-1^Main field is not a multiple"
QUIT
+44 IF ('$DATA(^DD(SUBFILE,SUBFIELD)))
SET ERR="-1^Did not pass valid field in multiple"
QUIT
+45 SET DR(2,SUBFILE)=SUBFIELD_"///"_SUBVALUE
End DoDot:1
if (ERR)
QUIT ERR
+46 ;MAKE SURE OTHER USER ISN'T EDITING ENTRY
+47 LOCK +(@(DIE_DA_")")):60
if ('$TEST)
QUIT "-1^Could not edit entry (locked by other user)"
+48 DO ^DIE
+49 LOCK -(@(DIE_DA_")"))
+50 if ($DATA(Y)#2)
QUIT "-1^Could not file new value"
+51 QUIT 0
