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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQADM22 4117 printed Sep 11, 2024@02:44:29 Page 2
VAQADM22 ;ALB/JRP - MESSAGE ADMINISTRATION;20-MAY-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**10**;NOV 17, 1993
AUTO(TRAN) ;AUTOMATIC PROCESSING OF REQUESTS
+1 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
+2 ;OUTPUT : 0 - Request processed
+3 ; -1^Error_Text - Error
+4 ;
+5 ;CHECK INPUT
+6 SET TRAN=+$GET(TRAN)
+7 if (('TRAN)!('$DATA(^VAT(394.61,TRAN))))
QUIT "-1^Valid transaction not passed"
+8 ;DECLARE VARIABLES
+9 NEW DOMAIN,SSN,TMP,AUTOPROC,NAME,XMITARR,LIMITARR,MAXARR,RELEASED
+10 SET XMITARR="^TMP(""VAQ-XMIT"","_$JOB_")"
+11 SET LIMITARR="^TMP(""VAQ-AUTOCHK"",""REQLIMITS"","_$JOB_")"
+12 SET MAXARR="^TMP(""VAQ-AUTOCHK"",""OVERLIMITS"","_$JOB_")"
+13 SET RELEASED=0
+14 KILL @XMITARR,@LIMITARR,@MAXARR
+15 ;GET REQUESTING DOMAIN
+16 SET DOMAIN=$PIECE($GET(^VAT(394.61,TRAN,"RQST2")),"^",2)
+17 ;GET PATIENT'S NAME & SSN
+18 SET TMP=$GET(^VAT(394.61,TRAN,"QRY"))
+19 SET NAME=$PIECE(TMP,"^",1)
+20 SET SSN=$PIECE(TMP,"^",2)
+21 ;CHECK FOR SENSITIVE PATIENT & DOMAIN IN RELEASE GROUP
+22 if (SSN'="")
SET AUTOPROC=$$RES^VAQUTL99(DOMAIN,SSN)
+23 if (SSN="")
SET AUTOPROC=$$RES^VAQUTL99(DOMAIN,NAME)
+24 IF +AUTOPROC=-2
SET $PIECE(AUTOPROC,"^",2)="Exact match on name/ssn/dob not found, process manually for potential matches"
+25 ;GET TIME & OCCURRENCE LIMITS OF REQUESTED SEGMENTS
+26 SET TMP=$$BLDSEGS(TRAN,LIMITARR)
+27 ;CHECK TIME & OCCURRENCE LIMITS OF REQUESTED SEGMENTS
+28 IF (TMP)
Begin DoDot:1
+29 SET TMP=$$MAXCHCK^VAQADM23(LIMITARR,MAXARR)
+30 ;ALL LIMITS OK
+31 if ('TMP)
QUIT
+32 ;SOME LIMITS DIDN'T PASS (DON'T OVERRIDE OTHER CHECKS IF THEY FAILED)
+33 if ((+AUTOPROC)>0)
SET AUTOPROC="-20^Maximum time & occurrence limits exceeded by "_TMP_" segment"_$SELECT((TMP>1):"s",1:"")
End DoDot:1
+34 ;RELEASE INFORMATION (RELEASE=-1 ON ERROR)
+35 IF ((+AUTOPROC)>0)
Begin DoDot:1
+36 SET RELEASED=-1
+37 ;FILE PATIENT POINTER
+38 SET TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.03,("`"_$PIECE(AUTOPROC,"^",2)))
+39 if (TMP)
QUIT
+40 ;FILE RELEASE STATUS
+41 SET TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.05,"VAQ-RSLT")
+42 if (TMP)
QUIT
+43 ;FILE CURRENT STATUS
+44 SET TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.02,"VAQ-AUTO")
+45 if (TMP)
QUIT
+46 ;RESET PURGE FLAG
+47 SET TMP=$$FILEINFO^VAQFILE(394.61,TRAN,90,"NO")
+48 ;FILE AUTHORIZER INFORMATION
+49 SET TMP=$$FILEINFO^VAQFILE(394.61,TRAN,50,"NOW")
+50 if (TMP)
QUIT
+51 SET TMP=$$FILEINFO^VAQFILE(394.61,TRAN,51,"PDX Server")
+52 if (TMP)
QUIT
+53 ;QUEUE TRANSMISSION
+54 SET @XMITARR@(TRAN)=""
+55 SET TMP=$$GENTASK^VAQADM5(XMITARR)
+56 if (TMP>0)
SET RELEASED=1
+57 KILL @XMITARR
End DoDot:1
+58 ;DON'T RELEASE INFORMATION
+59 IF ((+AUTOPROC)<0)
Begin DoDot:1
+60 ;CHANGE RELEASE STATUS TO ACKNOWLEDGED
+61 SET TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.05,"VAQ-RQACK")
+62 ;CHANGE STATUS TO REQUIRES PROCESSING
+63 SET TMP=$$FILEINFO^VAQFILE(394.61,TRAN,.02,"VAQ-PROC")
+64 ;RESET PURGE FLAG
+65 SET TMP=$$FILEINFO^VAQFILE(394.61,TRAN,90,"NO")
+66 ;SEND ACK
+67 KILL @XMITARR
+68 SET @XMITARR@(TRAN)=""
+69 SET TMP=$$GENTASK^VAQADM5(XMITARR)
+70 KILL @XMITARR
End DoDot:1
+71 ;SEND BULLETIN
+72 SET TMP=$PIECE(AUTOPROC,"^",2)
+73 if (RELEASED<0)
SET TMP="Unable to queue transmission of results"
+74 if ((RELEASED<0)!('RELEASED))
SET TMP=$$PROCESS^VAQBUL02(TRAN,TMP,MAXARR)
+75 KILL @LIMITARR,@MAXARR,@XMITARR
+76 QUIT 0
+77 ;
BLDSEGS(TRANPTR,OUTARR) ;BUILD ARRAY OF SEGMENTS FOR A TRANSACTION
+1 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
+2 ; OUTARR - Output array (full global reference)
+3 ; OUTARR(Pointer)=Time^Occur
+4 ;OUTPUT : X - Number of segments placed into OUTARR
+5 ;NOTES : This call is used to build the input for $$MAXCHCK^VAQADM23
+6 ; : It is the responsibility of the programmer to ensure
+7 ; that OUTARR is killed before and after this call
+8 ;
+9 ;CHECK INPUT
+10 SET TRANPTR=+$GET(TRANPTR)
+11 if ('TRANPTR)
QUIT 0
+12 if ('$DATA(^VAT(394.61,TRANPTR)))
QUIT 0
+13 if ($GET(OUTARR)="")
QUIT 0
+14 ;DECLARE VARIABLES
+15 NEW TMP,POINTER,REQTIM,REQOCC,COUNT,NODE
+16 ;LOOP THROUGH ALL SEGMENTS IN TRANSACTION
+17 SET NODE=0
+18 SET COUNT=0
+19 FOR
SET NODE=+$ORDER(^VAT(394.61,TRANPTR,"SEG",NODE))
if ('NODE)
QUIT
Begin DoDot:1
+20 ;GET REQUESTED TIME & OCCURRENCE LIMITS
+21 SET TMP=$GET(^VAT(394.61,TRANPTR,"SEG",NODE,0))
+22 if (TMP="")
QUIT
+23 SET POINTER=$PIECE(TMP,"^",1)
+24 ;NOT A VALID POINTER - IGNORE
+25 if ('$DATA(^VAT(394.71,POINTER,0)))
QUIT
+26 SET REQTIM=$PIECE(TMP,"^",2)
+27 SET REQOCC=$PIECE(TMP,"^",3)
+28 ;PLACE INTO OUTPUT ARRAY & INCREMENT COUNT
+29 SET @OUTARR@(POINTER)=(REQTIM_"^"_REQOCC)
+30 SET COUNT=COUNT+1
End DoDot:1
+31 ;RETURN NUMBER OF SEGMENTS IN TRANSACTION
+32 QUIT COUNT
