source: FOIAVistA/tag/r/PATIENT_DATA_EXCHANGE-VAQ/VAQADM22.m@ 628

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