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

VAQBUL02.m

Go to the documentation of this file.
  1. VAQBUL02 ;ALB/JRP - BULLETINS;20-MAY-93
  1. ;;1.5;PATIENT DATA EXCHANGE;**9,16,20**;NOV 17, 1993
  1. PROCESS(TRANPTR,REASON,ARRAY1) ;SEND REQUIRES PROCESSING BULLETIN
  1. ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
  1. ; REASON - Why transaction requires processing
  1. ; ARRAY1 - Array of pointers to VAQ - DATA SEGMENT that
  1. ; were contained in the request but over the maximium
  1. ; time & occurrence limit allowed for automatic
  1. ; processing (full global ref)
  1. ; ARRAY1(Pointer)=MaxTime^MaxOccur^ReqTime^ReqOccur
  1. ;OUTPUT : 0 - Bulletin sent
  1. ; -1^Error_Text - Bulletin not sent
  1. ;NOTES : If segments were not checked against maximum limits, still
  1. ; pass an array reference for ARRAY1. If ARRAY1 doesn't exist
  1. ; the information will not be used.
  1. ;
  1. ;CHECK INPUT
  1. S TRANPTR=+$G(TRANPTR)
  1. Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass valid transaction"
  1. S REASON=$G(REASON)
  1. S ARRAY1=$G(ARRAY1)
  1. ;DECLARE VARIABLES
  1. N TRANNUM,TMP,NAME,PID,DOB,DOMAIN,X,LINE,USER,SITE,XMY,TMPARR
  1. N SEGPTR,SEGABB,MAXTIM,MAXOCC,TIME,OCCUR,SSN,Y,ERROR
  1. S TMPARR="^TMP(""VAQ-BUL"","_$J_")"
  1. K @TMPARR
  1. S TRANNUM=+$G(^VAT(394.61,TRANPTR,0))
  1. S TMP=$G(^VAT(394.61,TRANPTR,"QRY"))
  1. S NAME=$P(TMP,"^",1)
  1. S SSN=$P(TMP,"^",2)
  1. S DOB=$P(TMP,"^",3)
  1. S PID=$P(TMP,"^",4)
  1. S:(NAME="") NAME="Not listed"
  1. S:(PID="") PID=SSN
  1. S DOB=$$DOBFMT^VAQUTL99(DOB,0)
  1. S:(DOB="") DOB="Not listed"
  1. S USER=$P($G(^VAT(394.61,TRANPTR,"RQST1")),"^",2)
  1. S:(USER="") USER="Unknown"
  1. S TMP=$G(^VAT(394.61,TRANPTR,"RQST2"))
  1. S SITE=$P(TMP,"^",1)
  1. S DOMAIN=$P(TMP,"^",2)
  1. S:(SITE="") SITE="Could not be determined"
  1. S:(DOMAIN="") DOMAIN="Could not be determined"
  1. ;BUILD TEXT OF MESSAGE
  1. S LINE=1
  1. S TMP="The following PDX Request requires manual processing ..."
  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. S TMP=" Transaction number: "_TRANNUM
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=" Name: "_NAME
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=" PID: "_PID
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=" 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. S TMP=" Requested by: "_USER
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=" Site: "_SITE
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=" 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. S TMP=" Reason for manual processing:"
  1. S @TMPARR@(LINE,0)=TMP
  1. S LINE=LINE+1
  1. S TMP=" "_REASON
  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 SEGMENTS EXCEEDING MAXIMUM LIMITS (IF PASSED)
  1. I (ARRAY1'="") I (+$O(@ARRAY1@(""))) D
  1. .S TMP=" Segments that were over the allowable time & occurrence limits:"
  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. .S TMP=" Requested Maximum Requested Maximum"
  1. .S @TMPARR@(LINE,0)=TMP
  1. .S LINE=LINE+1
  1. .S TMP=" Segment Time Time Occurrence Occurrence"
  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. .S SEGPTR=""
  1. .F S SEGPTR=+$O(@ARRAY1@(SEGPTR)) Q:('SEGPTR) D
  1. ..S SEGABB=$P($G(^VAT(394.71,SEGPTR,0)),"^",2)
  1. ..Q:(SEGABB="")
  1. ..S TMP=$G(@ARRAY1@(SEGPTR))
  1. ..S MAXTIM=$P(TMP,"^",1)
  1. ..S:(MAXTIM="") MAXTIM="NA"
  1. ..S:(MAXTIM="@") MAXTIM="-"
  1. ..S MAXOCC=$P(TMP,"^",2)
  1. ..S:(MAXOCC="") MAXOCC="NA"
  1. ..S:(MAXOCC="@") MAXOCC="-"
  1. ..S TIME=$P(TMP,"^",3)
  1. ..S:(MAXTIM="NA") TIME="NA"
  1. ..S:(TIME="") TIME="-"
  1. ..S OCCUR=$P(TMP,"^",4)
  1. ..S:(MAXOCC="NA") OCCUR="NA"
  1. ..S:((OCCUR="")!(OCCUR=0)) OCCUR="-"
  1. ..S TMP=""
  1. ..S TMP=$$INSERT^VAQUTL1(SEGABB,TMP,3)
  1. ..S TMP=$$INSERT^VAQUTL1(TIME,TMP,16)
  1. ..S TMP=$$INSERT^VAQUTL1(MAXTIM,TMP,29)
  1. ..S TMP=$$INSERT^VAQUTL1(OCCUR,TMP,42)
  1. ..S TMP=$$INSERT^VAQUTL1(MAXOCC,TMP,56)
  1. ..S @TMPARR@(LINE,0)=TMP
  1. ..S LINE=LINE+1
  1. ;SEND TO PROCESSING GROUP
  1. S XMY("G.VAQ MANUAL PROCESSING")=""
  1. ;SEND TO SECURITY OFFICER IF LOCAL PATIENT IS SENSITIVE
  1. S:((+$$RES^VAQUTL99(DOMAIN,SSN))=-4) TMP=$$LOADXMY^DGSEC()
  1. S:((+$$RES^VAQUTL99(DOMAIN,NAME))=-4) TMP=$$LOADXMY^DGSEC()
  1. ;SEND BULLETIN
  1. S TMP="Process PDX Request for "_NAME
  1. S X="PDX"
  1. S Y="Patient Data eXchange"
  1. S ERROR=+$$SENDBULL^VAQBUL(TMP,X,Y,TMPARR)
  1. K @TMPARR
  1. Q:(ERROR<0) "-1^Unable to generate and send bulletin"
  1. Q 0