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

VAQCON6.m

Go to the documentation of this file. 
  1. VAQCON6 ;ALB/JRP - MESSAGE CONSTRUCTION;13-APR-93
  1.  ;;1.5;PATIENT DATA EXCHANGE;**6**;NOV 17, 1993
  1. PATIENT(TRANPTR,MESSNUM,ARRAY,OFFSET) ;CONSTRUCT PATIENT BLOCK
  1.  ;INPUT  : TRANPTR - Pointer to VAQ - TRANSACTION file
  1.  ;         MESSNUM - Message number to place block into
  1.  ;                   (if 0, block will be placed in ARRAY)
  1.  ;         ARRAY - Array to store block in (full global reference)
  1.  ;         OFFSET - Where to begin placing information (defaults to 0)
  1.  ;OUTPUT : N - Number of lines in block
  1.  ;        -1^Error_Text - Error
  1.  ;NOTES  : If MESSNUM=0, then the block will be placed into
  1.  ;           ARRAY(LineNumber)=Line_of_info
  1.  ;         If MESSNUM>0 then the block will be placed into
  1.  ;           ^XMB(3.9,MESSNUM,2,LineNumber,0)=Line_of_info
  1.  ;
  1.  ;CHECK INPUT
  1.  S TRANPTR=+$G(TRANPTR)
  1.  Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid pointer to VAQ - TRANSACTION file"
  1.  S MESSNUM=+$G(MESSNUM)
  1.  I (('MESSNUM)&($G(ARRAY)="")) Q "-1^Did not pass message number of reference to array"
  1.  I (MESSNUM) Q:('$D(^XMB(3.9,MESSNUM))) "-1^Valid message number not passed"
  1.  S OFFSET=+$G(OFFSET)
  1.  ;DECLARE VARIABLES
  1.  N TMP,LINE,TYPE,X,NAME,PID,SSN,DOB,DFN,SENSITIV
  1.  N KEY1,KEY2,STRING,ENCRYPT,ENCSTR,NCRYPTON,USER
  1.  S LINE=OFFSET
  1.  ;GET MESSAGE TYPE
  1.  S TMP=$$STATYPE^VAQCON1(TRANPTR)
  1.  Q:($P(TMP,"^",1)="-1") "-1^Could not determine status of message"
  1.  S TYPE=$P(TMP,"^",2)
  1.  Q:(TYPE="REC") "-1^Transaction is being received, not transmitted"
  1.  ;DETERMINE IF ENCRYPTION IS TURNED ON
  1.  S ENCRYPT=$$TRANENC^VAQUTL3(TRANPTR,2)
  1.  S NCRYPTON=$S(ENCRYPT'="":1,1:0)
  1.  ;SET UP EXECUTABLE CALL FOR ENCRYPTION ON
  1.  S:(ENCRYPT'="") ENCRYPT=("S ENCSTR="_ENCRYPT)
  1.  ;SET UP EXECUTABLE CALL FOR ENCRYPTION OFF
  1.  S:(ENCRYPT="") ENCRYPT="S ENCSTR=STRING"
  1.  ;DETERMINE CURRENT USER
  1.  S TMP=$$SENDER^VAQCON2(TRANPTR)
  1.  Q:($P(TMP,"^",1)="-1") "-1^Could not determine sender of message"
  1.  S USER=$P(TMP,"^",1)
  1.  ;GET ENCRYPTION KEYS
  1.  S KEY1=$$NAMEKEY^VAQUTL3(USER,1)
  1.  S KEY2=$$NAMEKEY^VAQUTL3(USER,0)
  1.  ;GET POINTER TO PATIENT FILE
  1.  S DFN=+$P($G(^VAT(394.61,TRANPTR,0)),"^",3)
  1.  ;DETERMINE SENSITIVITY OF PATIENT
  1.  S SENSITIV=+$$GETSEN^VAQUTL97(DFN)
  1.  S:(SENSITIV<0) SENSITIV=0
  1.  ;DETERMINE PATIENT INFO USING POINTER
  1.  I (DFN) D
  1.  .;GET INFO
  1.  .S TMP=$$PATINFO^VAQUTL1(DFN)
  1.  .;ON ERROR, GET INFO FROM TRANSACTION
  1.  .I (TMP<0) S DFN=0 Q
  1.  .S NAME=$P(TMP,"^",1)
  1.  .S SSN=$P(TMP,"^",2)
  1.  .S DOB=$P(TMP,"^",3)
  1.  .S PID=$P(TMP,"^",4)
  1.  .S SSN=$$DASHSSN^VAQUTL99(SSN)
  1.  .S DOB=$$DATE^VAQUTL99(DOB)
  1.  .S:(DOB="-1") DOB=""
  1.  .S DOB=$$DOBFMT^VAQUTL99(DOB,0)
  1.  ;DETERMINE PATIENT INFO USING TRANSACTION
  1.  I ('DFN) D
  1.  .;GET NODE WITH PATIENT INFO ON IT
  1.  .S TMP=$G(^VAT(394.61,TRANPTR,"QRY"))
  1.  .S NAME=$P(TMP,"^",1)
  1.  .S SSN=$$DASHSSN^VAQUTL99($P(TMP,"^",2))
  1.  .S DOB=$$DOBFMT^VAQUTL99($P(TMP,"^",3),0)
  1.  .S PID=$P(TMP,"^",4)
  1.  Q:((NAME="")&(SSN="")&(PID="")) "-1^Patient information not contained in VAQ - TRANSACTION file"
  1.  ;ENCRYPT NAME
  1.  S STRING=NAME
  1.  X ENCRYPT
  1.  S NAME=ENCSTR
  1.  ;ENCRYPT PATIENT ID
  1.  S STRING=PID
  1.  X ENCRYPT
  1.  S PID=ENCSTR
  1.  ;ENCRYPT SSN
  1.  S STRING=SSN
  1.  X ENCRYPT
  1.  S SSN=ENCSTR
  1.  ;ENCRYPT DATE OF BIRTH
  1.  S STRING=DOB
  1.  X ENCRYPT
  1.  S DOB=ENCSTR
  1.  ;ENCRYPT POINTER TO PATIENT
  1.  S STRING=DFN
  1.  X ENCRYPT
  1.  S DFN=ENCSTR
  1.  ;ENCRYPT SENSITIVITY FLAG
  1.  S STRING=SENSITIV
  1.  X ENCRYPT
  1.  S SENSITIV=ENCSTR
  1.  ;LINE 1
  1.  S TMP="$PATIENT"
  1.  S:('MESSNUM) @ARRAY@(LINE)=TMP
  1.  S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1.  S LINE=LINE+1
  1.  ;LINE 2
  1.  S TMP=NCRYPTON
  1.  S:('MESSNUM) @ARRAY@(LINE)=TMP
  1.  S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1.  S LINE=LINE+1
  1.  ;LINE 3
  1.  S TMP=NAME
  1.  S:('MESSNUM) @ARRAY@(LINE)=TMP
  1.  S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1.  S LINE=LINE+1
  1.  ;LINE 4
  1.  S TMP=PID
  1.  S:('MESSNUM) @ARRAY@(LINE)=TMP
  1.  S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1.  S LINE=LINE+1
  1.  ;LINE 5
  1.  S TMP=SSN
  1.  S:('MESSNUM) @ARRAY@(LINE)=TMP
  1.  S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1.  S LINE=LINE+1
  1.  ;LINE 6
  1.  S TMP=DOB
  1.  S:('MESSNUM) @ARRAY@(LINE)=TMP
  1.  S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1.  S LINE=LINE+1
  1.  ;LINE 7
  1.  S TMP=DFN
  1.  S:('MESSNUM) @ARRAY@(LINE)=TMP
  1.  S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1.  S LINE=LINE+1
  1.  ;LINE 8
  1.  S TMP=SENSITIV
  1.  S:('MESSNUM) @ARRAY@(LINE)=TMP
  1.  S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1.  S LINE=LINE+1
  1.  ;LINE 9
  1.  S TMP="$$PATIENT"
  1.  S:('MESSNUM) @ARRAY@(LINE)=TMP
  1.  S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
  1.  S LINE=LINE+1
  1.  Q (LINE-OFFSET)