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

VAQADM22.m

Go to the documentation of this file.
  1. VAQADM22 ;ALB/JRP - MESSAGE ADMINISTRATION;20-MAY-93
  1. ;;1.5;PATIENT DATA EXCHANGE;**10**;NOV 17, 1993
  1. AUTO(TRAN) ;AUTOMATIC PROCESSING OF REQUESTS
  1. ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
  1. ;OUTPUT : 0 - Request processed
  1. ; -1^Error_Text - Error
  1. ;
  1. ;CHECK INPUT
  1. S TRAN=+$G(TRAN)
  1. Q:(('TRAN)!('$D(^VAT(394.61,TRAN)))) "-1^Valid transaction not passed"
  1. ;DECLARE VARIABLES
  1. N DOMAIN,SSN,TMP,AUTOPROC,NAME,XMITARR,LIMITARR,MAXARR,RELEASED
  1. S XMITARR="^TMP(""VAQ-XMIT"","_$J_")"
  1. S LIMITARR="^TMP(""VAQ-AUTOCHK"",""REQLIMITS"","_$J_")"
  1. S MAXARR="^TMP(""VAQ-AUTOCHK"",""OVERLIMITS"","_$J_")"
  1. S RELEASED=0
  1. K @XMITARR,@LIMITARR,@MAXARR
  1. ;GET REQUESTING DOMAIN
  1. S DOMAIN=$P($G(^VAT(394.61,TRAN,"RQST2")),"^",2)
  1. ;GET PATIENT'S NAME & SSN
  1. S TMP=$G(^VAT(394.61,TRAN,"QRY"))
  1. S NAME=$P(TMP,"^",1)
  1. S SSN=$P(TMP,"^",2)
  1. ;CHECK FOR SENSITIVE PATIENT & DOMAIN IN RELEASE GROUP
  1. S:(SSN'="") AUTOPROC=$$RES^VAQUTL99(DOMAIN,SSN)
  1. S:(SSN="") AUTOPROC=$$RES^VAQUTL99(DOMAIN,NAME)
  1. I +AUTOPROC=-2 S $P(AUTOPROC,"^",2)="Exact match on name/ssn/dob not found, process manually for potential matches"
  1. ;GET TIME & OCCURRENCE LIMITS OF REQUESTED SEGMENTS
  1. S TMP=$$BLDSEGS(TRAN,LIMITARR)
  1. ;CHECK TIME & OCCURRENCE LIMITS OF REQUESTED SEGMENTS
  1. I (TMP) D
  1. .S TMP=$$MAXCHCK^VAQADM23(LIMITARR,MAXARR)
  1. .;ALL LIMITS OK
  1. .Q:('TMP)
  1. .;SOME LIMITS DIDN'T PASS (DON'T OVERRIDE OTHER CHECKS IF THEY FAILED)
  1. .S:((+AUTOPROC)>0) AUTOPROC="-20^Maximum time & occurrence limits exceeded by "_TMP_" segment"_$S((TMP>1):"s",1:"")
  1. ;RELEASE INFORMATION (RELEASE=-1 ON ERROR)
  1. I ((+AUTOPROC)>0) D
  1. .S RELEASED=-1
  1. .;FILE PATIENT POINTER
  1. .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.03,("`"_$P(AUTOPROC,"^",2)))
  1. .Q:(TMP)
  1. .;FILE RELEASE STATUS
  1. .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.05,"VAQ-RSLT")
  1. .Q:(TMP)
  1. .;FILE CURRENT STATUS
  1. .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.02,"VAQ-AUTO")
  1. .Q:(TMP)
  1. .;RESET PURGE FLAG
  1. .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,90,"NO")
  1. .;FILE AUTHORIZER INFORMATION
  1. .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,50,"NOW")
  1. .Q:(TMP)
  1. .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,51,"PDX Server")
  1. .Q:(TMP)
  1. .;QUEUE TRANSMISSION
  1. .S @XMITARR@(TRAN)=""
  1. .S TMP=$$GENTASK^VAQADM5(XMITARR)
  1. .S:(TMP>0) RELEASED=1
  1. .K @XMITARR
  1. ;DON'T RELEASE INFORMATION
  1. I ((+AUTOPROC)<0) D
  1. .;CHANGE RELEASE STATUS TO ACKNOWLEDGED
  1. .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.05,"VAQ-RQACK")
  1. .;CHANGE STATUS TO REQUIRES PROCESSING
  1. .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.02,"VAQ-PROC")
  1. .;RESET PURGE FLAG
  1. .S TMP=$$FILEINFO^VAQFILE(394.61,TRAN,90,"NO")
  1. .;SEND ACK
  1. .K @XMITARR
  1. .S @XMITARR@(TRAN)=""
  1. .S TMP=$$GENTASK^VAQADM5(XMITARR)
  1. .K @XMITARR
  1. ;SEND BULLETIN
  1. S TMP=$P(AUTOPROC,"^",2)
  1. S:(RELEASED<0) TMP="Unable to queue transmission of results"
  1. S:((RELEASED<0)!('RELEASED)) TMP=$$PROCESS^VAQBUL02(TRAN,TMP,MAXARR)
  1. K @LIMITARR,@MAXARR,@XMITARR
  1. Q 0
  1. ;
  1. BLDSEGS(TRANPTR,OUTARR) ;BUILD ARRAY OF SEGMENTS FOR A TRANSACTION
  1. ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
  1. ; OUTARR - Output array (full global reference)
  1. ; OUTARR(Pointer)=Time^Occur
  1. ;OUTPUT : X - Number of segments placed into OUTARR
  1. ;NOTES : This call is used to build the input for $$MAXCHCK^VAQADM23
  1. ; : It is the responsibility of the programmer to ensure
  1. ; that OUTARR is killed before and after this call
  1. ;
  1. ;CHECK INPUT
  1. S TRANPTR=+$G(TRANPTR)
  1. Q:('TRANPTR) 0
  1. Q:('$D(^VAT(394.61,TRANPTR))) 0
  1. Q:($G(OUTARR)="") 0
  1. ;DECLARE VARIABLES
  1. N TMP,POINTER,REQTIM,REQOCC,COUNT,NODE
  1. ;LOOP THROUGH ALL SEGMENTS IN TRANSACTION
  1. S NODE=0
  1. S COUNT=0
  1. F S NODE=+$O(^VAT(394.61,TRANPTR,"SEG",NODE)) Q:('NODE) D
  1. .;GET REQUESTED TIME & OCCURRENCE LIMITS
  1. .S TMP=$G(^VAT(394.61,TRANPTR,"SEG",NODE,0))
  1. .Q:(TMP="")
  1. .S POINTER=$P(TMP,"^",1)
  1. .;NOT A VALID POINTER - IGNORE
  1. .Q:('$D(^VAT(394.71,POINTER,0)))
  1. .S REQTIM=$P(TMP,"^",2)
  1. .S REQOCC=$P(TMP,"^",3)
  1. .;PLACE INTO OUTPUT ARRAY & INCREMENT COUNT
  1. .S @OUTARR@(POINTER)=(REQTIM_"^"_REQOCC)
  1. .S COUNT=COUNT+1
  1. ;RETURN NUMBER OF SEGMENTS IN TRANSACTION
  1. Q COUNT