VistA-WorldVistAEHR/r/PATIENT_DATA_EXCHANGE-VAQ/VAQFIL17.m

88 lines
3.3 KiB
Mathematica

VAQFIL17 ;ALB/JRP - MESSAGE FILING;14-MAY-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DISPLAY(MESSNUM,PARSARR,TRANPTR) ;FILE ALL DISPLAY 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,"DISPLAY"))) 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,LINE,OFFSET,DATAPTR,SEGABB
N DECRYPT,KEY1,KEY2,STRING,DECSTR,DECMTHD,ENCRYPT,DSPLINES
;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 DISPLAY 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 DISPLAY BLOCK
S BLOCKSEQ=""
F S BLOCKSEQ=$O(@PARSARR@(MESSNUM,"DISPLAY",BLOCKSEQ)) Q:(BLOCKSEQ="") D
.;MAKE SURE IT'S A DISPLAY BLOCK
.S TMP=$G(@PARSARR@(MESSNUM,"DISPLAY",BLOCKSEQ,1))
.S:(TMP=" ") TMP=""
.Q:((TMP="")!(TMP'="$DISPLAY"))
.;GET SEGMENT ABBREVIATION
.S SEGABB=$G(@PARSARR@(MESSNUM,"DISPLAY",BLOCKSEQ,2))
.S:(SEGABB=" ") SEGABB=""
.Q:((SEGABB="")!(SEGABB="$$DISPLAY"))
.S TMP=$G(@PARSARR@(MESSNUM,"DISPLAY",BLOCKSEQ,3))
.S:(TMP=" ") TMP=""
.Q:((TMP="")!(TMP="$$DISPLAY"))
.S ENCRYPT=+$P(TMP,"^",1)
.S DSPLINES=+$P(TMP,"^",2)
.;SET UP FOR DECRYPTION
.Q:((ENCRYPT)&(DECMTHD=""))
.S:(ENCRYPT) DECRYPT=("S DECSTR="_DECMTHD)
.S:('ENCRYPT) DECRYPT="S DECSTR=STRING"
.Q:((ENCRYPT)&((KEY1="")!(KEY2="")))
.;CHECK NUMBER OF LINES IN DISPLAY
.Q:('DSPLINES)
.S DSPLINES=DSPLINES+1
.;MAKE STUB ENTRY IN DATA FILE
.S DATAPTR=$$STUBDATA^VAQFILE1(SEGABB,TRANPTR)
.Q:(DATAPTR<0)
.;PUT BLANK LINE INTO DISPLAY (SETS ZERO NODE)
.S TMP=$$FILEINFO^VAQFILE(394.62,DATAPTR,50," ")
.I (TMP) S TMP=$$DELDATA^VAQFILE1(DATAPTR) Q
.;STORE SEGMENT
.S LINE=1
.S OFFSET=3
.S TMP=""
.F S OFFSET=$O(@PARSARR@(MESSNUM,"DISPLAY",BLOCKSEQ,OFFSET)) Q:((OFFSET="")!(LINE=DSPLINES)) D
..S STRING=$G(@PARSARR@(MESSNUM,"DISPLAY",BLOCKSEQ,OFFSET))
..S:(STRING=" ") STRING=""
..X DECRYPT
..S TMP=DECSTR
..S ^VAT(394.62,DATAPTR,"DSP",LINE,0)=TMP
..S LINE=LINE+1
.I (OFFSET="") S TMP=$$DELDATA^VAQFILE1(DATAPTR) Q
.S TMP=$G(@PARSARR@(MESSNUM,"DISPLAY",BLOCKSEQ,OFFSET))
.I (TMP'="$$DISPLAY") S TMP=$$DELDATA^VAQFILE1(DATAPTR) Q
.;UPDATE ZERO NODE
.S LINE=LINE-1
.S TMP=$G(^VAT(394.62,DATAPTR,"DSP",0))
.S $P(TMP,"^",3)=LINE
.S $P(TMP,"^",4)=LINE
.S ^VAT(394.62,DATAPTR,"DSP",0)=TMP
Q 0