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

VAQBUL06.m

Go to the documentation of this file.
  1. VAQBUL06 ;ALB/JRP - BULLETINS;09-JUN-93
  1. ;;1.5;PATIENT DATA EXCHANGE;**9**;NOV 17, 1993
  1. UNSOL(TRANPTR) ;SEND UNSOLICITED RECEIVED BULLETIN
  1. ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
  1. ;OUTPUT : 0 - Bulletin sent
  1. ; -1^Error_Text - Bulletin not sent
  1. ;
  1. ;CHECK INPUT
  1. S TRANPTR=+$G(TRANPTR)
  1. Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass valid transaction"
  1. ;DECLARE VARIABLES
  1. N TRANNUM,NAME,PID,DOB,ATHRBY,SITE,DOMAIN,RCVON
  1. N TMP,TMPARR,LINE,OFFSET,SPACE,COMMENT,X,DIWL,DIWR,DIWF
  1. N SENSITVE,XMY,Y,ERROR
  1. S TMPARR="^TMP(""VAQ-BUL"","_$J_")"
  1. K @TMPARR,^UTILITY($J,"W")
  1. S SPACE=" "
  1. ;MAKE SURE TRANSACTION IS AN UNSOLICITED
  1. S TMP=$$STATYPE^VAQCON1(TRANPTR,1)
  1. Q:($P(TMP,"^",1)="-1") TMP
  1. Q:($P(TMP,"^",2)'="UNS") "-1^Transaction was not an Unsolicited PDX"
  1. ;GET TRANSACTION NUMBER
  1. S TMP=$G(^VAT(394.61,TRANPTR,0))
  1. S TRANNUM=+TMP
  1. Q:('TRANNUM) "-1^Transaction did not contain a transaction number"
  1. ;CHECK REMOTE SENSITIVITY
  1. S SENSITVE=+$P(TMP,"^",4)
  1. ;GET PATIENT INFORMATION
  1. S TMP=$G(^VAT(394.61,TRANPTR,"QRY"))
  1. S NAME=$P(TMP,"^",1)
  1. S:(NAME="") NAME="Not listed"
  1. S DOB=$$DOBFMT^VAQUTL99($P(TMP,"^",3),0)
  1. S:(DOB="") DOB="Not listed"
  1. S PID=$P(TMP,"^",4)
  1. I (PID="") D
  1. .;GET PID FROM SSN
  1. .S PID=$P(TMP,"^",2)
  1. .I (PID="") S PID="Not listed" Q
  1. .S PID=$$DASHSSN^VAQUTL99(PID)
  1. ;GET TRANSACTION INFORMATION
  1. S TMP=$G(^VAT(394.61,TRANPTR,"ATHR1"))
  1. S RCVON=$$DOBFMT^VAQUTL99($P(TMP,"^",1),1)
  1. S:(RCVON="") RCVON="Could not be determined"
  1. S ATHRBY=$P(TMP,"^",2)
  1. S:(ATHRBY="") ATHBY="Uknown"
  1. S TMP=$G(^VAT(394.61,TRANPTR,"ATHR2"))
  1. S SITE=$P(TMP,"^",1)
  1. S:(SITE="") SITE="Could not be determined"
  1. S DOMAIN=$P(TMP,"^",2)
  1. S:(DOMAIN="") DOMAIN="Could not be determined"
  1. ;BUILD MESSAGE
  1. S LINE=1
  1. S TMP="The following Unsolicited PDX has been received ..."
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=""
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. ;PUT IN TRANSACTION INFO
  1. S TMP=SPACE_"Transaction number: "_TRANNUM
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=SPACE_"Name: "_NAME
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=SPACE_"PID: "_PID
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=SPACE_"DOB: "_DOB
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=""
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. ;PRINT SENSITIVITY
  1. I (SENSITVE) D
  1. .S TMP="*** PATIENT WAS LISTED AS SENSITIVE AT THE REMOTE FACILITY ***"
  1. .S TMP=SPACE_TMP
  1. .S @TMPARR@(LINE,0)=TMP
  1. .S LINE=LINE+1
  1. .S TMP=""
  1. .S @TMPARR@(LINE,0)=TMP
  1. .S LINE=LINE+1
  1. ;PUT IN RECEIVING INFO
  1. S TMP=SPACE_"Received on: "_RCVON
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=""
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. ;PUT IN AUTHORIZING INFO
  1. S TMP=SPACE_"Sent by: "_ATHRBY
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=SPACE_"Site: "_SITE
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=SPACE_"Domain: "_DOMAIN
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=""
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. ;DETERMINE IF COMMENT EXIST
  1. S COMMENT=0
  1. S COMMENT=$D(^VAT(394.61,TRANPTR,"CMNT"))
  1. S:(COMMENT) COMMENT=+$O(^VAT(394.61,TRANPTR,"CMNT",0))
  1. ;NO COMMENT/REASON
  1. I ('COMMENT) D
  1. .S TMP=SPACE_"Comments: None listed"
  1. .S @TMPARR@(LINE,0)=TMP
  1. .S LINE=LINE+1
  1. ;COMMENT/REASON
  1. I (COMMENT) D
  1. .S TMP=SPACE_"Comments:"
  1. .S @TMPARR@(LINE,0)=TMP
  1. .S LINE=LINE+1
  1. .;FORMAT TEXT
  1. .K ^UTILITY($J,"W")
  1. .S OFFSET=0
  1. .F S OFFSET=+$O(^VAT(394.61,TRANPTR,"CMNT",OFFSET)) Q:('OFFSET) D
  1. ..S X=$G(^VAT(394.61,TRANPTR,"CMNT",OFFSET,0))
  1. ..S DIWL=0
  1. ..S DIWR=0
  1. ..S DIWF="I"_$L(SPACE)_"C75"
  1. ..D ^DIWP
  1. .;PUT COMMENT INTO MESSAGE
  1. .S OFFSET=""
  1. .F S OFFSET=$O(^UTILITY($J,"W",0,OFFSET)) Q:(OFFSET="") D
  1. ..S TMP=$G(^UTILITY($J,"W",0,OFFSET,0))
  1. ..S @TMPARR@(LINE,0)=TMP
  1. ..S LINE=LINE+1
  1. .K ^UTILITY($J,"W")
  1. ;SEND TO UNSOLICITED MAIL GROUP
  1. S XMY("G.VAQ UNSOLICITED RECEIVED")=""
  1. ;ADD SECURITY OFFICER IF PATIENT IS SENSITIVE AT REMOTE FACILITY
  1. S:(SENSITVE) X=$$LOADXMY^DGSEC()
  1. ;SEND BULLETIN
  1. S TMP="Unsolicited PDX for "_NAME
  1. S X="PDX"
  1. S Y="Patient Data eXchange"
  1. S ERROR=$$SENDBULL^VAQBUL(TMP,X,Y,TMPARR)
  1. S:(ERROR>0) ERROR=0
  1. ;DONE (CLEAN UP)
  1. K @TMPARR,^UTILITY($J,"W")
  1. Q ERROR