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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQFIL17 3474 printed Dec 13, 2024@02:25:52 Page 2
VAQFIL17 ;ALB/JRP - MESSAGE FILING;14-MAY-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DISPLAY(MESSNUM,PARSARR,TRANPTR) ;FILE ALL DISPLAY 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,"DISPLAY")))
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,LINE,OFFSET,DATAPTR,SEGABB
+23 NEW DECRYPT,KEY1,KEY2,STRING,DECSTR,DECMTHD,ENCRYPT,DSPLINES
+24 ;GET MESSAGE TYPE
+25 SET TMP=$$STATYPE^VAQFIL11(MESSNUM,PARSARR)
+26 if ($PIECE(TMP,"^",1)="-1")
QUIT "-1^Could not determine message type"
+27 SET TYPE=$PIECE(TMP,"^",2)
+28 ;ACK & RETRANSMIT & REQUEST DON'T HAVE DISPLAY BLOCKS
+29 if ((TYPE="ACK")!(TYPE="RET")!(TYPE="REQ"))
QUIT "-1^Message type does not require display block"
+30 ;GET DECRYPTION METHOD & KEYS
+31 SET DECMTHD=$$DECMTHD^VAQFIL11(MESSNUM,PARSARR,2)
+32 SET KEY1=$$KEY^VAQFIL13(MESSNUM,PARSARR,1)
+33 SET KEY2=$$KEY^VAQFIL13(MESSNUM,PARSARR,0)
+34 ;LOOP THROUGH EACH DISPLAY BLOCK
+35 SET BLOCKSEQ=""
+36 FOR
SET BLOCKSEQ=$ORDER(@PARSARR@(MESSNUM,"DISPLAY",BLOCKSEQ))
if (BLOCKSEQ="")
QUIT
Begin DoDot:1
+37 ;MAKE SURE IT'S A DISPLAY BLOCK
+38 SET TMP=$GET(@PARSARR@(MESSNUM,"DISPLAY",BLOCKSEQ,1))
+39 if (TMP=" ")
SET TMP=""
+40 if ((TMP="")!(TMP'="$DISPLAY"))
QUIT
+41 ;GET SEGMENT ABBREVIATION
+42 SET SEGABB=$GET(@PARSARR@(MESSNUM,"DISPLAY",BLOCKSEQ,2))
+43 if (SEGABB=" ")
SET SEGABB=""
+44 if ((SEGABB="")!(SEGABB="$$DISPLAY"))
QUIT
+45 SET TMP=$GET(@PARSARR@(MESSNUM,"DISPLAY",BLOCKSEQ,3))
+46 if (TMP=" ")
SET TMP=""
+47 if ((TMP="")!(TMP="$$DISPLAY"))
QUIT
+48 SET ENCRYPT=+$PIECE(TMP,"^",1)
+49 SET DSPLINES=+$PIECE(TMP,"^",2)
+50 ;SET UP FOR DECRYPTION
+51 if ((ENCRYPT)&(DECMTHD=""))
QUIT
+52 if (ENCRYPT)
SET DECRYPT=("S DECSTR="_DECMTHD)
+53 if ('ENCRYPT)
SET DECRYPT="S DECSTR=STRING"
+54 if ((ENCRYPT)&((KEY1="")!(KEY2="")))
QUIT
+55 ;CHECK NUMBER OF LINES IN DISPLAY
+56 if ('DSPLINES)
QUIT
+57 SET DSPLINES=DSPLINES+1
+58 ;MAKE STUB ENTRY IN DATA FILE
+59 SET DATAPTR=$$STUBDATA^VAQFILE1(SEGABB,TRANPTR)
+60 if (DATAPTR<0)
QUIT
+61 ;PUT BLANK LINE INTO DISPLAY (SETS ZERO NODE)
+62 SET TMP=$$FILEINFO^VAQFILE(394.62,DATAPTR,50," ")
+63 IF (TMP)
SET TMP=$$DELDATA^VAQFILE1(DATAPTR)
QUIT
+64 ;STORE SEGMENT
+65 SET LINE=1
+66 SET OFFSET=3
+67 SET TMP=""
+68 FOR
SET OFFSET=$ORDER(@PARSARR@(MESSNUM,"DISPLAY",BLOCKSEQ,OFFSET))
if ((OFFSET="")!(LINE=DSPLINES))
QUIT
Begin DoDot:2
+69 SET STRING=$GET(@PARSARR@(MESSNUM,"DISPLAY",BLOCKSEQ,OFFSET))
+70 if (STRING=" ")
SET STRING=""
+71 XECUTE DECRYPT
+72 SET TMP=DECSTR
+73 SET ^VAT(394.62,DATAPTR,"DSP",LINE,0)=TMP
+74 SET LINE=LINE+1
End DoDot:2
+75 IF (OFFSET="")
SET TMP=$$DELDATA^VAQFILE1(DATAPTR)
QUIT
+76 SET TMP=$GET(@PARSARR@(MESSNUM,"DISPLAY",BLOCKSEQ,OFFSET))
+77 IF (TMP'="$$DISPLAY")
SET TMP=$$DELDATA^VAQFILE1(DATAPTR)
QUIT
+78 ;UPDATE ZERO NODE
+79 SET LINE=LINE-1
+80 SET TMP=$GET(^VAT(394.62,DATAPTR,"DSP",0))
+81 SET $PIECE(TMP,"^",3)=LINE
+82 SET $PIECE(TMP,"^",4)=LINE
+83 SET ^VAT(394.62,DATAPTR,"DSP",0)=TMP
End DoDot:1
+84 QUIT 0
