VAQFIL18 ;ALB/JRP - MESSAGE FILING;18-MAY-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DATA(MESSNUM,PARSARR,TRANPTR) ;FILE ALL DATA BLOCKS
;INPUT : MESSNUM - Message number in transmission (not XMZ)
; (defaults to 1)
; PARSARR - Parsing array (full global reference)
; TRANPTR - Pointer to VAQ - TRANSACTION file
; (As defined by MailMan)
; XMFROM, XMREC,XMZ
;OUTPUT : 0 - Success
; -1^Error_Text - Error
;NOTES : It is the responsibility of the calling program to correct
; the transaction being updated if an error occurs.
; : If the displayable segment can not be added, it will delete
; the entry that is created for it in VAQ - DATA file.
;
;CHECK INPUT
S:($G(MESSNUM)="") MESSNUM=1
Q:($G(PARSARR)="") "-1^Did not pass reference to parsing array"
Q:('$D(@PARSARR@(MESSNUM))) "-1^Did not pass valid message number"
Q:('$D(@PARSARR@(MESSNUM,"DATA"))) 0
S TRANPTR=+$G(TRANPTR)
Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid transaction"
;DECLARE VARIABLES
N BLOCKSEQ,TMP,TYPE,SEQ,ERR,OFFSET,DATAPTR,SEGABB,FILE,FIELD,TMPARR
N DECRYPT,KEY1,KEY2,STRING,DECSTR,DECMTHD,ENCRYPT,VALUE,ID,SEQCNT
S TMPARR="^TMP(""VAQ-TMP"","_$J_")"
K @TMPARR
;GET MESSAGE TYPE
S TMP=$$STATYPE^VAQFIL11(MESSNUM,PARSARR)
Q:($P(TMP,"^",1)="-1") "-1^Could not determine message type"
S TYPE=$P(TMP,"^",2)
;ACK & RETRANSMIT & REQUEST DON'T HAVE DATA BLOCKS
Q:((TYPE="ACK")!(TYPE="RET")!(TYPE="REQ")) "-1^Message type does not require display block"
;GET DECRYPTION METHOD & KEYS
S DECMTHD=$$DECMTHD^VAQFIL11(MESSNUM,PARSARR,2)
S KEY1=$$KEY^VAQFIL13(MESSNUM,PARSARR,1)
S KEY2=$$KEY^VAQFIL13(MESSNUM,PARSARR,0)
;LOOP THROUGH EACH DATA BLOCK
S BLOCKSEQ=""
F S BLOCKSEQ=$O(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ)) Q:(BLOCKSEQ="") D
.;MAKE SURE IT'S A DATA BLOCK
.S TMP=$G(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,1))
.S:(TMP=" ") TMP=""
.Q:((TMP="")!(TMP'="$DATA"))
.;GET SEGMENT ABBREVIATION
.S SEGABB=$G(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,2))
.S:(SEGABB=" ") SEGABB=""
.Q:((SEGABB="")!(SEGABB="$$DATA"))
.;CREATE EXTRACTION ARRAY FOR DATA BLOCK
.K @TMPARR
.S OFFSET=2
.F S OFFSET=$O(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,OFFSET)) Q:(OFFSET="") D Q:(OFFSET="")
..;READ DESCRIPTION BLOCK
..S TMP=$G(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,OFFSET))
..S:(TMP=" ") TMP=""
..Q:((TMP="")!(TMP="$$DATA"))
..S ENCRYPT=+$P(TMP,"^",1)
..S FILE=+$P(TMP,"^",2)
..S FIELD=+$P(TMP,"^",3)
..S SEQCNT=+$P(TMP,"^",4)
..Q:(('FILE)!('FIELD)!('SEQCNT))
..;READ EACH VALUE & ID
..S SEQCNT=SEQCNT-1
..F SEQ=0:1:SEQCNT D Q:(OFFSET="")
...S OFFSET=$O(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,OFFSET))
...Q:(OFFSET="")
...S VALUE=$G(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,OFFSET))
...S:(VALUE=" ") VALUE=""
...S OFFSET=$O(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,OFFSET))
...Q:(OFFSET="")
...S ID=$G(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,OFFSET))
...S:(ID=" ") ID=""
...;SET UP FOR DECRYPTION
...Q:((ENCRYPT)&(DECMTHD=""))
...S:(ENCRYPT) DECRYPT=("S DECSTR="_DECMTHD)
...S:('ENCRYPT) DECRYPT="S DECSTR=STRING"
...Q:((ENCRYPT)&((KEY1="")!(KEY2="")))
...;DECRYPT VALUE
...S STRING=VALUE
...X DECRYPT
...S VALUE=DECSTR
...;REBUILD EXTRACTION ARRAY (REMEMBER IF VALUE WAS DECRYPTED)
...S @TMPARR@("VALUE",FILE,FIELD,SEQ)=VALUE
...S @TMPARR@("ID",FILE,FIELD,SEQ)=ID
...I (STRING'="") S:(STRING'=DECSTR) @TMPARR@("DECRYPT",STRING)=DECSTR
..Q:(OFFSET="")
.;STORE INFORMATION
.S FILE=""
.F S FILE=$O(@TMPARR@("VALUE",FILE)) Q:(FILE="") D
..S FIELD=""
..F S FIELD=$O(@TMPARR@("VALUE",FILE,FIELD)) Q:(FIELD="") D
...S SEQ=""
...F S SEQ=$O(@TMPARR@("VALUE",FILE,FIELD,SEQ)) Q:(SEQ="") D
....S VALUE=$G(@TMPARR@("VALUE",FILE,FIELD,SEQ))
....S ID=$G(@TMPARR@("ID",FILE,FIELD,SEQ))
....;SEE IF ID SHOULD BE DECRYPTED
....I (ID'="") S:($D(@TMPARR@("DECRYPT",ID))) ID=$G(@TMPARR@("DECRYPT",ID))
....;MAKE STUB ENTRY IN DATA FILE
....S DATAPTR=$$STUBDATA^VAQFILE1(SEGABB,TRANPTR)
....Q:(DATAPTR<0)
....;STORE DATA
....S TMP=$$FILEINFO^VAQFILE(394.62,DATAPTR,.03,FILE)
....I (TMP) S TMP=$$DELDATA^VAQFILE1(DATAPTR) Q
....S TMP=$$FILEINFO^VAQFILE(394.62,DATAPTR,.04,FIELD)
....I (TMP) S TMP=$$DELDATA^VAQFILE1(DATAPTR) Q
....S TMP=$$FILEINFO^VAQFILE(394.62,DATAPTR,10,VALUE)
....I (TMP) S TMP=$$DELDATA^VAQFILE1(DATAPTR) Q
....S TMP=$$FILEINFO^VAQFILE(394.62,DATAPTR,20,ID)
....I (TMP) S TMP=$$DELDATA^VAQFILE1(DATAPTR) Q
....S TMP=$$FILEINFO^VAQFILE(394.62,DATAPTR,30,SEQ)
....I (TMP) S TMP=$$DELDATA^VAQFILE1(DATAPTR) Q
.K @TMPARR
K @TMPARR
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQFIL18 4671 printed Sep 23, 2025@20:01:32 Page 2
VAQFIL18 ;ALB/JRP - MESSAGE FILING;18-MAY-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DATA(MESSNUM,PARSARR,TRANPTR) ;FILE ALL DATA BLOCKS
+1 ;INPUT : MESSNUM - Message number in transmission (not XMZ)
+2 ; (defaults to 1)
+3 ; PARSARR - Parsing array (full global reference)
+4 ; TRANPTR - Pointer to VAQ - TRANSACTION file
+5 ; (As defined by MailMan)
+6 ; XMFROM, XMREC,XMZ
+7 ;OUTPUT : 0 - Success
+8 ; -1^Error_Text - Error
+9 ;NOTES : It is the responsibility of the calling program to correct
+10 ; the transaction being updated if an error occurs.
+11 ; : If the displayable segment can not be added, it will delete
+12 ; the entry that is created for it in VAQ - DATA file.
+13 ;
+14 ;CHECK INPUT
+15 if ($GET(MESSNUM)="")
SET MESSNUM=1
+16 if ($GET(PARSARR)="")
QUIT "-1^Did not pass reference to parsing array"
+17 if ('$DATA(@PARSARR@(MESSNUM)))
QUIT "-1^Did not pass valid message number"
+18 if ('$DATA(@PARSARR@(MESSNUM,"DATA")))
QUIT 0
+19 SET TRANPTR=+$GET(TRANPTR)
+20 if (('TRANPTR)!('$DATA(^VAT(394.61,TRANPTR))))
QUIT "-1^Did not pass a valid transaction"
+21 ;DECLARE VARIABLES
+22 NEW BLOCKSEQ,TMP,TYPE,SEQ,ERR,OFFSET,DATAPTR,SEGABB,FILE,FIELD,TMPARR
+23 NEW DECRYPT,KEY1,KEY2,STRING,DECSTR,DECMTHD,ENCRYPT,VALUE,ID,SEQCNT
+24 SET TMPARR="^TMP(""VAQ-TMP"","_$JOB_")"
+25 KILL @TMPARR
+26 ;GET MESSAGE TYPE
+27 SET TMP=$$STATYPE^VAQFIL11(MESSNUM,PARSARR)
+28 if ($PIECE(TMP,"^",1)="-1")
QUIT "-1^Could not determine message type"
+29 SET TYPE=$PIECE(TMP,"^",2)
+30 ;ACK & RETRANSMIT & REQUEST DON'T HAVE DATA BLOCKS
+31 if ((TYPE="ACK")!(TYPE="RET")!(TYPE="REQ"))
QUIT "-1^Message type does not require display block"
+32 ;GET DECRYPTION METHOD & KEYS
+33 SET DECMTHD=$$DECMTHD^VAQFIL11(MESSNUM,PARSARR,2)
+34 SET KEY1=$$KEY^VAQFIL13(MESSNUM,PARSARR,1)
+35 SET KEY2=$$KEY^VAQFIL13(MESSNUM,PARSARR,0)
+36 ;LOOP THROUGH EACH DATA BLOCK
+37 SET BLOCKSEQ=""
+38 FOR
SET BLOCKSEQ=$ORDER(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ))
if (BLOCKSEQ="")
QUIT
Begin DoDot:1
+39 ;MAKE SURE IT'S A DATA BLOCK
+40 SET TMP=$GET(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,1))
+41 if (TMP=" ")
SET TMP=""
+42 if ((TMP="")!(TMP'="$DATA"))
QUIT
+43 ;GET SEGMENT ABBREVIATION
+44 SET SEGABB=$GET(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,2))
+45 if (SEGABB=" ")
SET SEGABB=""
+46 if ((SEGABB="")!(SEGABB="$$DATA"))
QUIT
+47 ;CREATE EXTRACTION ARRAY FOR DATA BLOCK
+48 KILL @TMPARR
+49 SET OFFSET=2
+50 FOR
SET OFFSET=$ORDER(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,OFFSET))
if (OFFSET="")
QUIT
Begin DoDot:2
+51 ;READ DESCRIPTION BLOCK
+52 SET TMP=$GET(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,OFFSET))
+53 if (TMP=" ")
SET TMP=""
+54 if ((TMP="")!(TMP="$$DATA"))
QUIT
+55 SET ENCRYPT=+$PIECE(TMP,"^",1)
+56 SET FILE=+$PIECE(TMP,"^",2)
+57 SET FIELD=+$PIECE(TMP,"^",3)
+58 SET SEQCNT=+$PIECE(TMP,"^",4)
+59 if (('FILE)!('FIELD)!('SEQCNT))
QUIT
+60 ;READ EACH VALUE & ID
+61 SET SEQCNT=SEQCNT-1
+62 FOR SEQ=0:1:SEQCNT
Begin DoDot:3
+63 SET OFFSET=$ORDER(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,OFFSET))
+64 if (OFFSET="")
QUIT
+65 SET VALUE=$GET(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,OFFSET))
+66 if (VALUE=" ")
SET VALUE=""
+67 SET OFFSET=$ORDER(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,OFFSET))
+68 if (OFFSET="")
QUIT
+69 SET ID=$GET(@PARSARR@(MESSNUM,"DATA",BLOCKSEQ,OFFSET))
+70 if (ID=" ")
SET ID=""
+71 ;SET UP FOR DECRYPTION
+72 if ((ENCRYPT)&(DECMTHD=""))
QUIT
+73 if (ENCRYPT)
SET DECRYPT=("S DECSTR="_DECMTHD)
+74 if ('ENCRYPT)
SET DECRYPT="S DECSTR=STRING"
+75 if ((ENCRYPT)&((KEY1="")!(KEY2="")))
QUIT
+76 ;DECRYPT VALUE
+77 SET STRING=VALUE
+78 XECUTE DECRYPT
+79 SET VALUE=DECSTR
+80 ;REBUILD EXTRACTION ARRAY (REMEMBER IF VALUE WAS DECRYPTED)
+81 SET @TMPARR@("VALUE",FILE,FIELD,SEQ)=VALUE
+82 SET @TMPARR@("ID",FILE,FIELD,SEQ)=ID
+83 IF (STRING'="")
if (STRING'=DECSTR)
SET @TMPARR@("DECRYPT",STRING)=DECSTR
End DoDot:3
if (OFFSET="")
QUIT
+84 if (OFFSET="")
QUIT
End DoDot:2
if (OFFSET="")
QUIT
+85 ;STORE INFORMATION
+86 SET FILE=""
+87 FOR
SET FILE=$ORDER(@TMPARR@("VALUE",FILE))
if (FILE="")
QUIT
Begin DoDot:2
+88 SET FIELD=""
+89 FOR
SET FIELD=$ORDER(@TMPARR@("VALUE",FILE,FIELD))
if (FIELD="")
QUIT
Begin DoDot:3
+90 SET SEQ=""
+91 FOR
SET SEQ=$ORDER(@TMPARR@("VALUE",FILE,FIELD,SEQ))
if (SEQ="")
QUIT
Begin DoDot:4
+92 SET VALUE=$GET(@TMPARR@("VALUE",FILE,FIELD,SEQ))
+93 SET ID=$GET(@TMPARR@("ID",FILE,FIELD,SEQ))
+94 ;SEE IF ID SHOULD BE DECRYPTED
+95 IF (ID'="")
if ($DATA(@TMPARR@("DECRYPT",ID)))
SET ID=$GET(@TMPARR@("DECRYPT",ID))
+96 ;MAKE STUB ENTRY IN DATA FILE
+97 SET DATAPTR=$$STUBDATA^VAQFILE1(SEGABB,TRANPTR)
+98 if (DATAPTR<0)
QUIT
+99 ;STORE DATA
+100 SET TMP=$$FILEINFO^VAQFILE(394.62,DATAPTR,.03,FILE)
+101 IF (TMP)
SET TMP=$$DELDATA^VAQFILE1(DATAPTR)
QUIT
+102 SET TMP=$$FILEINFO^VAQFILE(394.62,DATAPTR,.04,FIELD)
+103 IF (TMP)
SET TMP=$$DELDATA^VAQFILE1(DATAPTR)
QUIT
+104 SET TMP=$$FILEINFO^VAQFILE(394.62,DATAPTR,10,VALUE)
+105 IF (TMP)
SET TMP=$$DELDATA^VAQFILE1(DATAPTR)
QUIT
+106 SET TMP=$$FILEINFO^VAQFILE(394.62,DATAPTR,20,ID)
+107 IF (TMP)
SET TMP=$$DELDATA^VAQFILE1(DATAPTR)
QUIT
+108 SET TMP=$$FILEINFO^VAQFILE(394.62,DATAPTR,30,SEQ)
+109 IF (TMP)
SET TMP=$$DELDATA^VAQFILE1(DATAPTR)
QUIT
End DoDot:4
End DoDot:3
End DoDot:2
+110 KILL @TMPARR
End DoDot:1
+111 KILL @TMPARR
+112 QUIT 0
