VAQBUL02 ;ALB/JRP - BULLETINS;20-MAY-93
;;1.5;PATIENT DATA EXCHANGE;**9,16,20**;NOV 17, 1993
PROCESS(TRANPTR,REASON,ARRAY1) ;SEND REQUIRES PROCESSING BULLETIN
;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
; REASON - Why transaction requires processing
; ARRAY1 - Array of pointers to VAQ - DATA SEGMENT that
; were contained in the request but over the maximium
; time & occurrence limit allowed for automatic
; processing (full global ref)
; ARRAY1(Pointer)=MaxTime^MaxOccur^ReqTime^ReqOccur
;OUTPUT : 0 - Bulletin sent
; -1^Error_Text - Bulletin not sent
;NOTES : If segments were not checked against maximum limits, still
; pass an array reference for ARRAY1. If ARRAY1 doesn't exist
; the information will not be used.
;
;CHECK INPUT
S TRANPTR=+$G(TRANPTR)
Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass valid transaction"
S REASON=$G(REASON)
S ARRAY1=$G(ARRAY1)
;DECLARE VARIABLES
N TRANNUM,TMP,NAME,PID,DOB,DOMAIN,X,LINE,USER,SITE,XMY,TMPARR
N SEGPTR,SEGABB,MAXTIM,MAXOCC,TIME,OCCUR,SSN,Y,ERROR
S TMPARR="^TMP(""VAQ-BUL"","_$J_")"
K @TMPARR
S TRANNUM=+$G(^VAT(394.61,TRANPTR,0))
S TMP=$G(^VAT(394.61,TRANPTR,"QRY"))
S NAME=$P(TMP,"^",1)
S SSN=$P(TMP,"^",2)
S DOB=$P(TMP,"^",3)
S PID=$P(TMP,"^",4)
S:(NAME="") NAME="Not listed"
S:(PID="") PID=SSN
S DOB=$$DOBFMT^VAQUTL99(DOB,0)
S:(DOB="") DOB="Not listed"
S USER=$P($G(^VAT(394.61,TRANPTR,"RQST1")),"^",2)
S:(USER="") USER="Unknown"
S TMP=$G(^VAT(394.61,TRANPTR,"RQST2"))
S SITE=$P(TMP,"^",1)
S DOMAIN=$P(TMP,"^",2)
S:(SITE="") SITE="Could not be determined"
S:(DOMAIN="") DOMAIN="Could not be determined"
;BUILD TEXT OF MESSAGE
S LINE=1
S TMP="The following PDX Request requires manual processing ..."
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=""
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=" Transaction number: "_TRANNUM
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=" Name: "_NAME
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=" PID: "_PID
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=" DOB: "_DOB
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=""
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=" Requested by: "_USER
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=" Site: "_SITE
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=" Domain: "_DOMAIN
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=""
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=" Reason for manual processing:"
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=" "_REASON
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
S TMP=""
S @TMPARR@(LINE,0)=TMP
S LINE=LINE+1
;PRINT SEGMENTS EXCEEDING MAXIMUM LIMITS (IF PASSED)
I (ARRAY1'="") I (+$O(@ARRAY1@(""))) D
.S TMP=" Segments that were over the allowable time & occurrence limits:"
.S @TMPARR@(LINE,0)=TMP
.S LINE=LINE+1
.S TMP=""
.S @TMPARR@(LINE,0)=TMP
.S LINE=LINE+1
.S TMP=" Requested Maximum Requested Maximum"
.S @TMPARR@(LINE,0)=TMP
.S LINE=LINE+1
.S TMP=" Segment Time Time Occurrence Occurrence"
.S @TMPARR@(LINE,0)=TMP
.S LINE=LINE+1
.S TMP=" ------- --------- ------- ---------- ----------"
.S @TMPARR@(LINE,0)=TMP
.S LINE=LINE+1
.S SEGPTR=""
.F S SEGPTR=+$O(@ARRAY1@(SEGPTR)) Q:('SEGPTR) D
..S SEGABB=$P($G(^VAT(394.71,SEGPTR,0)),"^",2)
..Q:(SEGABB="")
..S TMP=$G(@ARRAY1@(SEGPTR))
..S MAXTIM=$P(TMP,"^",1)
..S:(MAXTIM="") MAXTIM="NA"
..S:(MAXTIM="@") MAXTIM="-"
..S MAXOCC=$P(TMP,"^",2)
..S:(MAXOCC="") MAXOCC="NA"
..S:(MAXOCC="@") MAXOCC="-"
..S TIME=$P(TMP,"^",3)
..S:(MAXTIM="NA") TIME="NA"
..S:(TIME="") TIME="-"
..S OCCUR=$P(TMP,"^",4)
..S:(MAXOCC="NA") OCCUR="NA"
..S:((OCCUR="")!(OCCUR=0)) OCCUR="-"
..S TMP=""
..S TMP=$$INSERT^VAQUTL1(SEGABB,TMP,3)
..S TMP=$$INSERT^VAQUTL1(TIME,TMP,16)
..S TMP=$$INSERT^VAQUTL1(MAXTIM,TMP,29)
..S TMP=$$INSERT^VAQUTL1(OCCUR,TMP,42)
..S TMP=$$INSERT^VAQUTL1(MAXOCC,TMP,56)
..S @TMPARR@(LINE,0)=TMP
..S LINE=LINE+1
;SEND TO PROCESSING GROUP
S XMY("G.VAQ MANUAL PROCESSING")=""
;SEND TO SECURITY OFFICER IF LOCAL PATIENT IS SENSITIVE
S:((+$$RES^VAQUTL99(DOMAIN,SSN))=-4) TMP=$$LOADXMY^DGSEC()
S:((+$$RES^VAQUTL99(DOMAIN,NAME))=-4) TMP=$$LOADXMY^DGSEC()
;SEND BULLETIN
S TMP="Process PDX Request for "_NAME
S X="PDX"
S Y="Patient Data eXchange"
S ERROR=+$$SENDBULL^VAQBUL(TMP,X,Y,TMPARR)
K @TMPARR
Q:(ERROR<0) "-1^Unable to generate and send bulletin"
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQBUL02 4627 printed Dec 13, 2024@02:24:36 Page 2
VAQBUL02 ;ALB/JRP - BULLETINS;20-MAY-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**9,16,20**;NOV 17, 1993
PROCESS(TRANPTR,REASON,ARRAY1) ;SEND REQUIRES PROCESSING BULLETIN
+1 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
+2 ; REASON - Why transaction requires processing
+3 ; ARRAY1 - Array of pointers to VAQ - DATA SEGMENT that
+4 ; were contained in the request but over the maximium
+5 ; time & occurrence limit allowed for automatic
+6 ; processing (full global ref)
+7 ; ARRAY1(Pointer)=MaxTime^MaxOccur^ReqTime^ReqOccur
+8 ;OUTPUT : 0 - Bulletin sent
+9 ; -1^Error_Text - Bulletin not sent
+10 ;NOTES : If segments were not checked against maximum limits, still
+11 ; pass an array reference for ARRAY1. If ARRAY1 doesn't exist
+12 ; the information will not be used.
+13 ;
+14 ;CHECK INPUT
+15 SET TRANPTR=+$GET(TRANPTR)
+16 if (('TRANPTR)!('$DATA(^VAT(394.61,TRANPTR))))
QUIT "-1^Did not pass valid transaction"
+17 SET REASON=$GET(REASON)
+18 SET ARRAY1=$GET(ARRAY1)
+19 ;DECLARE VARIABLES
+20 NEW TRANNUM,TMP,NAME,PID,DOB,DOMAIN,X,LINE,USER,SITE,XMY,TMPARR
+21 NEW SEGPTR,SEGABB,MAXTIM,MAXOCC,TIME,OCCUR,SSN,Y,ERROR
+22 SET TMPARR="^TMP(""VAQ-BUL"","_$JOB_")"
+23 KILL @TMPARR
+24 SET TRANNUM=+$GET(^VAT(394.61,TRANPTR,0))
+25 SET TMP=$GET(^VAT(394.61,TRANPTR,"QRY"))
+26 SET NAME=$PIECE(TMP,"^",1)
+27 SET SSN=$PIECE(TMP,"^",2)
+28 SET DOB=$PIECE(TMP,"^",3)
+29 SET PID=$PIECE(TMP,"^",4)
+30 if (NAME="")
SET NAME="Not listed"
+31 if (PID="")
SET PID=SSN
+32 SET DOB=$$DOBFMT^VAQUTL99(DOB,0)
+33 if (DOB="")
SET DOB="Not listed"
+34 SET USER=$PIECE($GET(^VAT(394.61,TRANPTR,"RQST1")),"^",2)
+35 if (USER="")
SET USER="Unknown"
+36 SET TMP=$GET(^VAT(394.61,TRANPTR,"RQST2"))
+37 SET SITE=$PIECE(TMP,"^",1)
+38 SET DOMAIN=$PIECE(TMP,"^",2)
+39 if (SITE="")
SET SITE="Could not be determined"
+40 if (DOMAIN="")
SET DOMAIN="Could not be determined"
+41 ;BUILD TEXT OF MESSAGE
+42 SET LINE=1
+43 SET TMP="The following PDX Request requires manual processing ..."
+44 SET @TMPARR@(LINE,0)=TMP
+45 SET LINE=LINE+1
+46 SET TMP=""
+47 SET @TMPARR@(LINE,0)=TMP
+48 SET LINE=LINE+1
+49 SET TMP=" Transaction number: "_TRANNUM
+50 SET @TMPARR@(LINE,0)=TMP
+51 SET LINE=LINE+1
+52 SET TMP=" Name: "_NAME
+53 SET @TMPARR@(LINE,0)=TMP
+54 SET LINE=LINE+1
+55 SET TMP=" PID: "_PID
+56 SET @TMPARR@(LINE,0)=TMP
+57 SET LINE=LINE+1
+58 SET TMP=" DOB: "_DOB
+59 SET @TMPARR@(LINE,0)=TMP
+60 SET LINE=LINE+1
+61 SET TMP=""
+62 SET @TMPARR@(LINE,0)=TMP
+63 SET LINE=LINE+1
+64 SET TMP=" Requested by: "_USER
+65 SET @TMPARR@(LINE,0)=TMP
+66 SET LINE=LINE+1
+67 SET TMP=" Site: "_SITE
+68 SET @TMPARR@(LINE,0)=TMP
+69 SET LINE=LINE+1
+70 SET TMP=" Domain: "_DOMAIN
+71 SET @TMPARR@(LINE,0)=TMP
+72 SET LINE=LINE+1
+73 SET TMP=""
+74 SET @TMPARR@(LINE,0)=TMP
+75 SET LINE=LINE+1
+76 SET TMP=" Reason for manual processing:"
+77 SET @TMPARR@(LINE,0)=TMP
+78 SET LINE=LINE+1
+79 SET TMP=" "_REASON
+80 SET @TMPARR@(LINE,0)=TMP
+81 SET LINE=LINE+1
+82 SET TMP=""
+83 SET @TMPARR@(LINE,0)=TMP
+84 SET LINE=LINE+1
+85 ;PRINT SEGMENTS EXCEEDING MAXIMUM LIMITS (IF PASSED)
+86 IF (ARRAY1'="")
IF (+$ORDER(@ARRAY1@("")))
Begin DoDot:1
+87 SET TMP=" Segments that were over the allowable time & occurrence limits:"
+88 SET @TMPARR@(LINE,0)=TMP
+89 SET LINE=LINE+1
+90 SET TMP=""
+91 SET @TMPARR@(LINE,0)=TMP
+92 SET LINE=LINE+1
+93 SET TMP=" Requested Maximum Requested Maximum"
+94 SET @TMPARR@(LINE,0)=TMP
+95 SET LINE=LINE+1
+96 SET TMP=" Segment Time Time Occurrence Occurrence"
+97 SET @TMPARR@(LINE,0)=TMP
+98 SET LINE=LINE+1
+99 SET TMP=" ------- --------- ------- ---------- ----------"
+100 SET @TMPARR@(LINE,0)=TMP
+101 SET LINE=LINE+1
+102 SET SEGPTR=""
+103 FOR
SET SEGPTR=+$ORDER(@ARRAY1@(SEGPTR))
if ('SEGPTR)
QUIT
Begin DoDot:2
+104 SET SEGABB=$PIECE($GET(^VAT(394.71,SEGPTR,0)),"^",2)
+105 if (SEGABB="")
QUIT
+106 SET TMP=$GET(@ARRAY1@(SEGPTR))
+107 SET MAXTIM=$PIECE(TMP,"^",1)
+108 if (MAXTIM="")
SET MAXTIM="NA"
+109 if (MAXTIM="@")
SET MAXTIM="-"
+110 SET MAXOCC=$PIECE(TMP,"^",2)
+111 if (MAXOCC="")
SET MAXOCC="NA"
+112 if (MAXOCC="@")
SET MAXOCC="-"
+113 SET TIME=$PIECE(TMP,"^",3)
+114 if (MAXTIM="NA")
SET TIME="NA"
+115 if (TIME="")
SET TIME="-"
+116 SET OCCUR=$PIECE(TMP,"^",4)
+117 if (MAXOCC="NA")
SET OCCUR="NA"
+118 if ((OCCUR="")!(OCCUR=0))
SET OCCUR="-"
+119 SET TMP=""
+120 SET TMP=$$INSERT^VAQUTL1(SEGABB,TMP,3)
+121 SET TMP=$$INSERT^VAQUTL1(TIME,TMP,16)
+122 SET TMP=$$INSERT^VAQUTL1(MAXTIM,TMP,29)
+123 SET TMP=$$INSERT^VAQUTL1(OCCUR,TMP,42)
+124 SET TMP=$$INSERT^VAQUTL1(MAXOCC,TMP,56)
+125 SET @TMPARR@(LINE,0)=TMP
+126 SET LINE=LINE+1
End DoDot:2
End DoDot:1
+127 ;SEND TO PROCESSING GROUP
+128 SET XMY("G.VAQ MANUAL PROCESSING")=""
+129 ;SEND TO SECURITY OFFICER IF LOCAL PATIENT IS SENSITIVE
+130 if ((+$$RES^VAQUTL99(DOMAIN,SSN))=-4)
SET TMP=$$LOADXMY^DGSEC()
+131 if ((+$$RES^VAQUTL99(DOMAIN,NAME))=-4)
SET TMP=$$LOADXMY^DGSEC()
+132 ;SEND BULLETIN
+133 SET TMP="Process PDX Request for "_NAME
+134 SET X="PDX"
+135 SET Y="Patient Data eXchange"
+136 SET ERROR=+$$SENDBULL^VAQBUL(TMP,X,Y,TMPARR)
+137 KILL @TMPARR
+138 if (ERROR<0)
QUIT "-1^Unable to generate and send bulletin"
+139 QUIT 0
