VAQBUL06 ;ALB/JRP - BULLETINS;09-JUN-93
;;1.5;PATIENT DATA EXCHANGE;**9**;NOV 17, 1993
UNSOL(TRANPTR) ;SEND UNSOLICITED RECEIVED BULLETIN
;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
;OUTPUT : 0 - Bulletin sent
; -1^Error_Text - Bulletin not sent
;
;CHECK INPUT
S TRANPTR=+$G(TRANPTR)
Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass valid transaction"
;DECLARE VARIABLES
N TRANNUM,NAME,PID,DOB,ATHRBY,SITE,DOMAIN,RCVON
N TMP,TMPARR,LINE,OFFSET,SPACE,COMMENT,X,DIWL,DIWR,DIWF
N SENSITVE,XMY,Y,ERROR
S TMPARR="^TMP(""VAQ-BUL"","_$J_")"
K @TMPARR,^UTILITY($J,"W")
S SPACE=" "
;MAKE SURE TRANSACTION IS AN UNSOLICITED
S TMP=$$STATYPE^VAQCON1(TRANPTR,1)
Q:($P(TMP,"^",1)="-1") TMP
Q:($P(TMP,"^",2)'="UNS") "-1^Transaction was not an Unsolicited PDX"
;GET TRANSACTION NUMBER
S TMP=$G(^VAT(394.61,TRANPTR,0))
S TRANNUM=+TMP
Q:('TRANNUM) "-1^Transaction did not contain a transaction number"
;CHECK REMOTE SENSITIVITY
S SENSITVE=+$P(TMP,"^",4)
;GET PATIENT INFORMATION
S TMP=$G(^VAT(394.61,TRANPTR,"QRY"))
S NAME=$P(TMP,"^",1)
S:(NAME="") NAME="Not listed"
S DOB=$$DOBFMT^VAQUTL99($P(TMP,"^",3),0)
S:(DOB="") DOB="Not listed"
S PID=$P(TMP,"^",4)
I (PID="") D
.;GET PID FROM SSN
.S PID=$P(TMP,"^",2)
.I (PID="") S PID="Not listed" Q
.S PID=$$DASHSSN^VAQUTL99(PID)
;GET TRANSACTION INFORMATION
S TMP=$G(^VAT(394.61,TRANPTR,"ATHR1"))
S RCVON=$$DOBFMT^VAQUTL99($P(TMP,"^",1),1)
S:(RCVON="") RCVON="Could not be determined"
S ATHRBY=$P(TMP,"^",2)
S:(ATHRBY="") ATHBY="Uknown"
S TMP=$G(^VAT(394.61,TRANPTR,"ATHR2"))
S SITE=$P(TMP,"^",1)
S:(SITE="") SITE="Could not be determined"
S DOMAIN=$P(TMP,"^",2)
S:(DOMAIN="") DOMAIN="Could not be determined"
;BUILD MESSAGE
S LINE=1
S TMP="The following Unsolicited PDX has been received ..."
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=""
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
;PUT IN TRANSACTION INFO
S TMP=SPACE_"Transaction number: "_TRANNUM
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=SPACE_"Name: "_NAME
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=SPACE_"PID: "_PID
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=SPACE_"DOB: "_DOB
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=""
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
;PRINT SENSITIVITY
I (SENSITVE) D
.S TMP="*** PATIENT WAS LISTED AS SENSITIVE AT THE REMOTE FACILITY ***"
.S TMP=SPACE_TMP
.S @TMPARR@(LINE,0)=TMP
.S LINE=LINE+1
.S TMP=""
.S @TMPARR@(LINE,0)=TMP
.S LINE=LINE+1
;PUT IN RECEIVING INFO
S TMP=SPACE_"Received on: "_RCVON
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=""
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
;PUT IN AUTHORIZING INFO
S TMP=SPACE_"Sent by: "_ATHRBY
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=SPACE_"Site: "_SITE
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=SPACE_"Domain: "_DOMAIN
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=""
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
;DETERMINE IF COMMENT EXIST
S COMMENT=0
S COMMENT=$D(^VAT(394.61,TRANPTR,"CMNT"))
S:(COMMENT) COMMENT=+$O(^VAT(394.61,TRANPTR,"CMNT",0))
;NO COMMENT/REASON
I ('COMMENT) D
.S TMP=SPACE_"Comments: None listed"
.S @TMPARR@(LINE,0)=TMP
.S LINE=LINE+1
;COMMENT/REASON
I (COMMENT) D
.S TMP=SPACE_"Comments:"
.S @TMPARR@(LINE,0)=TMP
.S LINE=LINE+1
.;FORMAT TEXT
.K ^UTILITY($J,"W")
.S OFFSET=0
.F S OFFSET=+$O(^VAT(394.61,TRANPTR,"CMNT",OFFSET)) Q:('OFFSET) D
..S X=$G(^VAT(394.61,TRANPTR,"CMNT",OFFSET,0))
..S DIWL=0
..S DIWR=0
..S DIWF="I"_$L(SPACE)_"C75"
..D ^DIWP
.;PUT COMMENT INTO MESSAGE
.S OFFSET=""
.F S OFFSET=$O(^UTILITY($J,"W",0,OFFSET)) Q:(OFFSET="") D
..S TMP=$G(^UTILITY($J,"W",0,OFFSET,0))
..S @TMPARR@(LINE,0)=TMP
..S LINE=LINE+1
.K ^UTILITY($J,"W")
;SEND TO UNSOLICITED MAIL GROUP
S XMY("G.VAQ UNSOLICITED RECEIVED")=""
;ADD SECURITY OFFICER IF PATIENT IS SENSITIVE AT REMOTE FACILITY
S:(SENSITVE) X=$$LOADXMY^DGSEC()
;SEND BULLETIN
S TMP="Unsolicited PDX for "_NAME
S X="PDX"
S Y="Patient Data eXchange"
S ERROR=$$SENDBULL^VAQBUL(TMP,X,Y,TMPARR)
S:(ERROR>0) ERROR=0
;DONE (CLEAN UP)
K @TMPARR,^UTILITY($J,"W")
Q ERROR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQBUL06 4213 printed Dec 13, 2024@02:24:40 Page 2
VAQBUL06 ;ALB/JRP - BULLETINS;09-JUN-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**9**;NOV 17, 1993
UNSOL(TRANPTR) ;SEND UNSOLICITED RECEIVED BULLETIN
+1 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
+2 ;OUTPUT : 0 - Bulletin sent
+3 ; -1^Error_Text - Bulletin not sent
+4 ;
+5 ;CHECK INPUT
+6 SET TRANPTR=+$GET(TRANPTR)
+7 if (('TRANPTR)!('$DATA(^VAT(394.61,TRANPTR))))
QUIT "-1^Did not pass valid transaction"
+8 ;DECLARE VARIABLES
+9 NEW TRANNUM,NAME,PID,DOB,ATHRBY,SITE,DOMAIN,RCVON
+10 NEW TMP,TMPARR,LINE,OFFSET,SPACE,COMMENT,X,DIWL,DIWR,DIWF
+11 NEW SENSITVE,XMY,Y,ERROR
+12 SET TMPARR="^TMP(""VAQ-BUL"","_$JOB_")"
+13 KILL @TMPARR,^UTILITY($JOB,"W")
+14 SET SPACE=" "
+15 ;MAKE SURE TRANSACTION IS AN UNSOLICITED
+16 SET TMP=$$STATYPE^VAQCON1(TRANPTR,1)
+17 if ($PIECE(TMP,"^",1)="-1")
QUIT TMP
+18 if ($PIECE(TMP,"^",2)'="UNS")
QUIT "-1^Transaction was not an Unsolicited PDX"
+19 ;GET TRANSACTION NUMBER
+20 SET TMP=$GET(^VAT(394.61,TRANPTR,0))
+21 SET TRANNUM=+TMP
+22 if ('TRANNUM)
QUIT "-1^Transaction did not contain a transaction number"
+23 ;CHECK REMOTE SENSITIVITY
+24 SET SENSITVE=+$PIECE(TMP,"^",4)
+25 ;GET PATIENT INFORMATION
+26 SET TMP=$GET(^VAT(394.61,TRANPTR,"QRY"))
+27 SET NAME=$PIECE(TMP,"^",1)
+28 if (NAME="")
SET NAME="Not listed"
+29 SET DOB=$$DOBFMT^VAQUTL99($PIECE(TMP,"^",3),0)
+30 if (DOB="")
SET DOB="Not listed"
+31 SET PID=$PIECE(TMP,"^",4)
+32 IF (PID="")
Begin DoDot:1
+33 ;GET PID FROM SSN
+34 SET PID=$PIECE(TMP,"^",2)
+35 IF (PID="")
SET PID="Not listed"
QUIT
+36 SET PID=$$DASHSSN^VAQUTL99(PID)
End DoDot:1
+37 ;GET TRANSACTION INFORMATION
+38 SET TMP=$GET(^VAT(394.61,TRANPTR,"ATHR1"))
+39 SET RCVON=$$DOBFMT^VAQUTL99($PIECE(TMP,"^",1),1)
+40 if (RCVON="")
SET RCVON="Could not be determined"
+41 SET ATHRBY=$PIECE(TMP,"^",2)
+42 if (ATHRBY="")
SET ATHBY="Uknown"
+43 SET TMP=$GET(^VAT(394.61,TRANPTR,"ATHR2"))
+44 SET SITE=$PIECE(TMP,"^",1)
+45 if (SITE="")
SET SITE="Could not be determined"
+46 SET DOMAIN=$PIECE(TMP,"^",2)
+47 if (DOMAIN="")
SET DOMAIN="Could not be determined"
+48 ;BUILD MESSAGE
+49 SET LINE=1
+50 SET TMP="The following Unsolicited PDX has been received ..."
+51 SET @TMPARR@(LINE,0)=TMP
+52 SET LINE=LINE+1
+53 SET TMP=""
+54 SET @TMPARR@(LINE,0)=TMP
+55 SET LINE=LINE+1
+56 ;PUT IN TRANSACTION INFO
+57 SET TMP=SPACE_"Transaction number: "_TRANNUM
+58 SET @TMPARR@(LINE,0)=TMP
+59 SET LINE=LINE+1
+60 SET TMP=SPACE_"Name: "_NAME
+61 SET @TMPARR@(LINE,0)=TMP
+62 SET LINE=LINE+1
+63 SET TMP=SPACE_"PID: "_PID
+64 SET @TMPARR@(LINE,0)=TMP
+65 SET LINE=LINE+1
+66 SET TMP=SPACE_"DOB: "_DOB
+67 SET @TMPARR@(LINE,0)=TMP
+68 SET LINE=LINE+1
+69 SET TMP=""
+70 SET @TMPARR@(LINE,0)=TMP
+71 SET LINE=LINE+1
+72 ;PRINT SENSITIVITY
+73 IF (SENSITVE)
Begin DoDot:1
+74 SET TMP="*** PATIENT WAS LISTED AS SENSITIVE AT THE REMOTE FACILITY ***"
+75 SET TMP=SPACE_TMP
+76 SET @TMPARR@(LINE,0)=TMP
+77 SET LINE=LINE+1
+78 SET TMP=""
+79 SET @TMPARR@(LINE,0)=TMP
+80 SET LINE=LINE+1
End DoDot:1
+81 ;PUT IN RECEIVING INFO
+82 SET TMP=SPACE_"Received on: "_RCVON
+83 SET @TMPARR@(LINE,0)=TMP
+84 SET LINE=LINE+1
+85 SET TMP=""
+86 SET @TMPARR@(LINE,0)=TMP
+87 SET LINE=LINE+1
+88 ;PUT IN AUTHORIZING INFO
+89 SET TMP=SPACE_"Sent by: "_ATHRBY
+90 SET @TMPARR@(LINE,0)=TMP
+91 SET LINE=LINE+1
+92 SET TMP=SPACE_"Site: "_SITE
+93 SET @TMPARR@(LINE,0)=TMP
+94 SET LINE=LINE+1
+95 SET TMP=SPACE_"Domain: "_DOMAIN
+96 SET @TMPARR@(LINE,0)=TMP
+97 SET LINE=LINE+1
+98 SET TMP=""
+99 SET @TMPARR@(LINE,0)=TMP
+100 SET LINE=LINE+1
+101 ;DETERMINE IF COMMENT EXIST
+102 SET COMMENT=0
+103 SET COMMENT=$DATA(^VAT(394.61,TRANPTR,"CMNT"))
+104 if (COMMENT)
SET COMMENT=+$ORDER(^VAT(394.61,TRANPTR,"CMNT",0))
+105 ;NO COMMENT/REASON
+106 IF ('COMMENT)
Begin DoDot:1
+107 SET TMP=SPACE_"Comments: None listed"
+108 SET @TMPARR@(LINE,0)=TMP
+109 SET LINE=LINE+1
End DoDot:1
+110 ;COMMENT/REASON
+111 IF (COMMENT)
Begin DoDot:1
+112 SET TMP=SPACE_"Comments:"
+113 SET @TMPARR@(LINE,0)=TMP
+114 SET LINE=LINE+1
+115 ;FORMAT TEXT
+116 KILL ^UTILITY($JOB,"W")
+117 SET OFFSET=0
+118 FOR
SET OFFSET=+$ORDER(^VAT(394.61,TRANPTR,"CMNT",OFFSET))
if ('OFFSET)
QUIT
Begin DoDot:2
+119 SET X=$GET(^VAT(394.61,TRANPTR,"CMNT",OFFSET,0))
+120 SET DIWL=0
+121 SET DIWR=0
+122 SET DIWF="I"_$LENGTH(SPACE)_"C75"
+123 DO ^DIWP
End DoDot:2
+124 ;PUT COMMENT INTO MESSAGE
+125 SET OFFSET=""
+126 FOR
SET OFFSET=$ORDER(^UTILITY($JOB,"W",0,OFFSET))
if (OFFSET="")
QUIT
Begin DoDot:2
+127 SET TMP=$GET(^UTILITY($JOB,"W",0,OFFSET,0))
+128 SET @TMPARR@(LINE,0)=TMP
+129 SET LINE=LINE+1
End DoDot:2
+130 KILL ^UTILITY($JOB,"W")
End DoDot:1
+131 ;SEND TO UNSOLICITED MAIL GROUP
+132 SET XMY("G.VAQ UNSOLICITED RECEIVED")=""
+133 ;ADD SECURITY OFFICER IF PATIENT IS SENSITIVE AT REMOTE FACILITY
+134 if (SENSITVE)
SET X=$$LOADXMY^DGSEC()
+135 ;SEND BULLETIN
+136 SET TMP="Unsolicited PDX for "_NAME
+137 SET X="PDX"
+138 SET Y="Patient Data eXchange"
+139 SET ERROR=$$SENDBULL^VAQBUL(TMP,X,Y,TMPARR)
+140 if (ERROR>0)
SET ERROR=0
+141 ;DONE (CLEAN UP)
+142 KILL @TMPARR,^UTILITY($JOB,"W")
+143 QUIT ERROR
