- 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 Jan 18, 2025@03:25:18 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