- 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 Jan 18, 2025@03:25:09 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