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