- 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 Feb 18, 2025@23:50:42 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