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

VAQPAR1.m

Go to the documentation of this file. 
  1. VAQPAR1 ;ALB/JRP - MESSAGE PARSING;28-APR-93
  1.  ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
  1. PREPRS10(ARRAY) ;PRE-PARSE VERSION 1.0 TRANSMISSION
  1.  ;INPUT  : ARRAY - Parsing array (full global reference)
  1.  ;         (As defined by MailMan)
  1.  ;         XMFROM, XMREC, XMZ
  1.  ;         (Declared in SERVER^VAQADM2)
  1.  ;         XMER, XMRG, XMPOS
  1.  ;OUTPUT : XMER - Exit condition
  1.  ;           0 = Success
  1.  ;           -1^Error_Text = Error
  1.  ;         XMPOS - Last line [number] read in transmission
  1.  ;                 (if NULL end of transmission reached)
  1.  ;
  1.  ;NOTES  : Parsing array will have the following format
  1.  ;           ARRAY(1,BlockName,LineNumber) = Value
  1.  ;       : Calling routine responsible for ARRAY clean up before
  1.  ;         and after call
  1.  ;       : This is not a function
  1.  ;
  1.  ;CHECK INPUT
  1.  I ($G(ARRAY)="") S XMER="-1^Did not pass reference to parsing array" Q
  1.  ;DECLARE VARIABLES
  1.  N LINE,ERR,BLOCK,TMP,X
  1.  S XMER=0
  1.  S LINE=1
  1.  ;READ HEADER
  1.  S BLOCK="HEADER"
  1.  X XMREC
  1.  I ((XMER<0)!(XMRG="")) S XMER="-1^Transmission did not contain any information" Q
  1.  S @ARRAY@(1,BLOCK,LINE)=XMRG
  1.  S LINE=LINE+1
  1.  ;QUIT IF TRANSMISSION IS AN ACK
  1.  Q:($P(XMRG,"^",1)="ACK")
  1.  X XMREC
  1.  I ((XMER<0)!(XMRG="")) S XMER="-1^Transmission was not complete" Q
  1.  S @ARRAY@(1,BLOCK,LINE)=XMRG
  1.  S LINE=LINE+1
  1.  ;CHECK TRANSMISSION TYPE
  1.  S TMP=+$P(@ARRAY@(1,BLOCK,1),"^",12)
  1.  ;TRANSMISSION TYPE NOT SUPPORTED
  1.  I ((TMP=17)!(TMP=19)!(TMP=20)) S XMER="-1^Transmission type not supported" Q
  1.  F X=10:1:21 Q:(TMP=X)
  1.  I (X=21) S XMER="-1^Transmission type not supported" Q
  1.  ;NO DATA BLOCKS IN TRANSMISSION
  1.  Q:((TMP'=15)&(TMP'=16))
  1.  ;READ DATA BLOCKS
  1.  S XMER=0
  1.  F  X XMREC Q:(XMER<0)  D
  1.  .;GET DATA BLOCK TYPE
  1.  .S TMP=$P(XMRG,"^",1)
  1.  .;NEW DATA BLOCK TYPE
  1.  .S:(TMP'=BLOCK) LINE=1
  1.  .;BLOCK NOT SUPPORTED (SKIP)
  1.  .Q:((TMP'="MIN")&(TMP'="MAS")&(TMP'="PHA"))
  1.  .S BLOCK=TMP
  1.  .S @ARRAY@(1,BLOCK,LINE)=$P(XMRG,"^",2,($L(XMRG,"^")))
  1.  .S LINE=LINE+1
  1.  S XMER=0
  1.  Q
  1.  ;
  1. PARSE10(ARRAY) ;PARSE 1.0 MESSAGE
  1.  ;INPUT  : ARRAY - Array containing pre-parsed version 1.0 transmission
  1.  ;                 (full global reference)
  1.  ;         (As defined by MailMan)
  1.  ;         XMFROM, XMREC, XMZ
  1.  ;         (Declared in SERVER^VAQADM2)
  1.  ;         XMER, XMRG, XMPOS
  1.  ;OUTPUT : XMER - Exit condition
  1.  ;           0 = Success
  1.  ;           -1^Error_Text = Error
  1.  ;NOTES  : Pre-parsed transmsission will be deleted from ARRAY
  1.  ;         and replaced with parsed array.  Parsed array will be same
  1.  ;         as parsed array for version 1.5 message and have the format:
  1.  ;           ARRAY(2,BlockName,BlockSeq,Line)
  1.  ;       : This is not a function
  1.  ;
  1.  ;CHECK INPUT
  1.  I ($G(ARRAY)="") S XMER="-1^Did not pass reference to parsing array" Q
  1.  I ('$D(@ARRAY@(1))) S XMER="-1^Parsing array did not contain pre-parsed transmission" Q
  1.  ;DECLARE VARIABLES
  1.  N TMP,BLOCK,ACK,TYPE,STATUS,X,Y
  1.  S XMER=0
  1.  ;DETERMINE IF MESSAGE IS AN ACKNOWLEDGMENT
  1.  S TMP=$G(@ARRAY@(1,"HEADER",1))
  1.  I (TMP="") S XMER="-1^Header did not exist in pre-parsed message" Q
  1.  S ACK=($P(TMP,"^",1)="ACK")
  1.  ;ACK
  1.  I (ACK) D
  1.  .;MAKE HEADER BLOCK
  1.  .S @ARRAY@(2,"HEADER",1,1)="$HEADER"
  1.  .S @ARRAY@(2,"HEADER",1,2)="ACK"
  1.  .S @ARRAY@(2,"HEADER",1,3)="VAQ-RQACK"
  1.  .S @ARRAY@(2,"HEADER",1,4)=1.0
  1.  .S @ARRAY@(2,"HEADER",1,5)=$$NOW^VAQUTL99(0,0)
  1.  .S @ARRAY@(2,"HEADER",1,6)=$G(XMZ)
  1.  .S @ARRAY@(2,"HEADER",1,7)=$P($G(@ARRAY@(1,"HEADER",1)),"^",2)
  1.  .S @ARRAY@(2,"HEADER",1,8)=""
  1.  .S @ARRAY@(2,"HEADER",1,9)="$$HEADER"
  1.  ;NOT AN ACK
  1.  I ('ACK) D
  1.  .;DETERMINE STATUS & TYPE
  1.  .S TMP=$G(@ARRAY@(1,"HEADER",1))
  1.  .S X=$P(TMP,"^",12)
  1.  .S:(X=10) STATUS="VAQ-RQST",TYPE="REQ"
  1.  .S:(X=11) STATUS="VAQ-AMBIG",TYPE="RES"
  1.  .S:(X=12) STATUS="VAQ-NTFND",TYPE="RES"
  1.  .S:((X=13)!(X=14)!(X=18)) STATUS="VAQ-REJ",TYPE="RES"
  1.  .S:(X=15) STATUS="VAQ-RSLT",TYPE="RES"
  1.  .S:(X=16) STATUS="VAQ-UNSOL",TYPE="UNS"
  1.  .S @ARRAY@(2,"HEADER",1,1)="$HEADER"
  1.  .S @ARRAY@(2,"HEADER",1,2)=TYPE
  1.  .S @ARRAY@(2,"HEADER",1,3)=STATUS
  1.  .S @ARRAY@(2,"HEADER",1,4)=1.0
  1.  .S X=+$P(TMP,"^",9)
  1.  .S Y=$P(X,".",2)
  1.  .S Y=Y_"000000"
  1.  .S $P(X,".",2)=Y
  1.  .S Y=$$DOBFMT^VAQUTL99(X)
  1.  .I (Y'="") D
  1.  ..S X=$P(X,".",2)
  1.  ..S Y=Y_"@"_$E(X,1,2)_":"_$E(X,3,4)_":"_$E(X,5,6)
  1.  .S @ARRAY@(2,"HEADER",1,5)=Y
  1.  .S @ARRAY@(2,"HEADER",1,6)=$G(XMZ)
  1.  .S X=""
  1.  .S:((TYPE="RES")!(TYPE="REQ")) X=+TMP
  1.  .S @ARRAY@(2,"HEADER",1,7)=X
  1.  .S @ARRAY@(2,"HEADER",1,8)=""
  1.  .S @ARRAY@(2,"HEADER",1,9)="$$HEADER"
  1.  ;MAKE DOMAIN BLOCK
  1.  S @ARRAY@(2,"DOMAIN",1,1)="$DOMAIN"
  1.  S X=$P($G(@ARRAY@(1,"HEADER",2)),"^",1)
  1.  S:(X="") X=$P($G(XMFROM),"@",2)
  1.  S @ARRAY@(2,"DOMAIN",1,2)=X
  1.  S @ARRAY@(2,"DOMAIN",1,3)=""
  1.  S @ARRAY@(2,"DOMAIN",1,4)="$$DOMAIN"
  1.  ;DONE IF ACK
  1.  Q:(ACK)
  1.  ;GO TO CONTINUATION ROUTINE
  1.  D PARCON^VAQPAR10
  1.  Q