Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQFILE

VAQFILE.m

Go to the documentation of this file.
  1. 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
  1. NEWTRAN() ;MAKE STUB ENTRY IN TRANSACTION FILE
  1. ;INPUT : NONE
  1. ;OUTPUT : IFN^Transaction_Number - Success
  1. ; -1^Error_text - Error
  1. ;
  1. ;DECLARE VARIABLES
  1. N DD,DIC,X,DINUM,Y,DLAYGO
  1. S X="+" ;-- auto numbering - see ^DD(394.61,.01,7.5). It involves $$AUTO^VAQXRF2(1) and file 394.86.
  1. S DIC="^VAT(394.61,",DIC(0)="L",DLAYGO=394.61
  1. D ^DIC
  1. I Y<0 Q "-1^Could not determine new transaction number"
  1. Q $P(Y,U,1,2)
  1. ;
  1. DELTRAN(TRANPTR) ;DELETE TRANSACTION
  1. ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
  1. ;OUTPUT : 0 - Success
  1. ; -1^Error_text - Error
  1. ;NOTES : This will also delete all entries in the VAQ - DATA file
  1. ; that are associated with the transaction.
  1. ;
  1. ;CHECK INPUT
  1. Q:('(+$G(TRANPTR))) "-1^Did not pass pointer to transaction"
  1. ;DECLARE VARIABLES
  1. N DIK,SEGMENT,DA,DATAPTR,TMP
  1. ;DELETE ENTRIES IN DATA FILE
  1. S (DATAPTR,SEGMENT)=""
  1. F S SEGMENT=$O(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT)) Q:'SEGMENT D
  1. . F S DATAPTR=+$O(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT,DATAPTR)) Q:'DATAPTR D
  1. . . I ('$D(^VAT(394.62,DATAPTR,0))&($D(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT,DATAPTR))=1)) D
  1. . . . K ^VAT(394.62,"A-SEGMENT",TRANPTR,SEGMENT,DATAPTR)
  1. . . Q:'DATAPTR
  1. . . S TMP=$$DELDATA^VAQFILE1(DATAPTR)
  1. . . Q:(TMP)
  1. ;IF TRANSACTION DOES NOT EXIST RETURN SUCCESS
  1. Q:('$D(^VAT(394.61,TRANPTR))) 0
  1. ;DELETE ENTRY IN TRANSACTION FILE
  1. S DIK="^VAT(394.61,"
  1. S DA=TRANPTR
  1. D ^DIK
  1. Q:($D(^VAT(394.61,TRANPTR))) "-1^Unable to delete transaction"
  1. Q 0
  1. ;
  1. FILEINFO(FILE,DA,FIELD,VALUE,SUBFIELD,SUBVALUE) ;FILE INFORMATION
  1. ;INPUT : FILE - File number
  1. ; DA - IFN of entry to edit
  1. ; FIELD - Field number
  1. ; VALUE - Information to be filed (defaults to '@')
  1. ; SUBFIELD - Field number in multiple
  1. ; SUBVALUE - Information to be filed in SUBFIELD of multiple
  1. ; (defaults to '@')
  1. ;OUTPUT : 0 - Success
  1. ; -1^Error_text - Error
  1. ;NOTES : If SUBFIELD is not passed, editing of a multiple will be
  1. ; ignored. If SUBFIELD is passed, the multiple under VALUE
  1. ; will be edited.
  1. ; : If working with a multiple, it is the responsibility of
  1. ; the calling routine to verify that VALUE can be added as
  1. ; an entry in the multiple. It is also the responsibility
  1. ; of the calling routine to verify that VALUE is an entry in
  1. ; the subfile when deleting/editing.
  1. ;
  1. ;CHECK INPUT
  1. N IFN,NAME,SSN,PID,SITE,DOMAIN
  1. Q:('$G(FILE)) "-1^Did not pass file number"
  1. Q:('$D(^DD(FILE))) "-1^Did not pass valid file number"
  1. Q:('$G(DA)) "-1^Did not pass entry number"
  1. Q:('$G(FIELD)) "-1^Did not pass field number"
  1. Q:('$D(^DD(FILE,FIELD))) "-1^Did not pass valid field number"
  1. S VALUE=$G(VALUE)
  1. ;REMOVE ';' FROM VALUE (CONFUSES CALL TO DIE)
  1. S VALUE=$TR(VALUE,";","")
  1. S:(VALUE="") VALUE="@"
  1. S SUBFIELD=+$G(SUBFIELD)
  1. S SUBVALUE=$G(SUBVALUE)
  1. S:(SUBVALUE="") SUBVALUE="@"
  1. ;DECLARE VARIABLES
  1. N DIE,DR,Y,X,SUBFILE,ERR
  1. S DIE=$G(^DIC(FILE,0,"GL"))
  1. Q:(DIE="") "-1^Could not determine global root of file"
  1. Q:('$D(@(DIE_DA_")"))) "-1^Did not pass valid entry number"
  1. S DR=FIELD_"///"_VALUE
  1. ;SET UP FOR MULTIPLE
  1. S ERR=0
  1. I (SUBFIELD) D Q:(ERR) ERR
  1. .S SUBFILE=+$P($G(^DD(FILE,FIELD,0)),"^",2)
  1. .I ('SUBFILE) S ERR="-1^Main field is not a multiple" Q
  1. .I ('$D(^DD(SUBFILE,SUBFIELD))) S ERR="-1^Did not pass valid field in multiple" Q
  1. .S DR(2,SUBFILE)=SUBFIELD_"///"_SUBVALUE
  1. ;MAKE SURE OTHER USER ISN'T EDITING ENTRY
  1. L +(@(DIE_DA_")")):60 Q:('$T) "-1^Could not edit entry (locked by other user)"
  1. D ^DIE
  1. L -(@(DIE_DA_")"))
  1. Q:($D(Y)#2) "-1^Could not file new value"
  1. Q 0