- 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 Jan 18, 2025@03:26:35 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