VAQUTL92 ;ALB/JFP,JRP - PDX TRANSACTION Lookup ;01-SEPT-93
;;1.5;PATIENT DATA EXCHANGE;**6,36**;NOV 17, 1993
;
TRNDATA(TRNPTR) ; -- Returns nodes in transaction file in local array NODE
; INPUT: TRNPTR = Pointer to VAQ - TRANSACTION FILE
; OUTPUT: 0 = Success
; see variable =
; -1^Reason = Bad input
;
; NOTE: Do KILLTRN to kill off variables created in this
; function.
;
Q:'(+$G(TRNPTR)) "-^Did not pass pointer to transaction file"
; -- Declare variables
K NODE
N ND,Y
; -- Main
F ND=0,"QRY","ATHR1","ATHR2","RQST1","RQST2" D
.S NODE(ND)=$G(^VAT(394.61,+TRNPTR,ND))
; -- Define variables
ZERO ; -- ZERO node
S VAQTRN=$P(NODE(0),U,1)
S VAQCSTAT=$P(NODE(0),U,2)
S VAQPTPTR=$P(NODE(0),U,3)
S VAQSENP=$P(NODE(0),U,4)
S VAQRSTAT=$P(NODE(0),U,5)
QRY ; -- QRY node
S VAQPTNM=$P(NODE("QRY"),U,1)
S VAQISSN=$P(NODE("QRY"),U,2)
S VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)
S VAQIDOB=$P(NODE("QRY"),U,3)
S VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)
S VAQPTID=$P(NODE("QRY"),U,4)
RQST1 ; -- RQST1 node
S Y=$P(NODE("RQST1"),U,1) X ^DD("DD") S VAQRDT=Y
S VAQRPER=$P(NODE("RQST1"),U,2) ; person requesting
RQST2 ; -- RQST2 node
S VAQRSITE=$P(NODE("RQST2"),U,1)
S VAQRDOM=$P(NODE("RQST2"),U,2)
ATHR1 ; -- ATHR1 node
S Y=$P(NODE("ATHR1"),U,1) X ^DD("DD") S VAQADT=Y
S VAQAPER=$P(NODE("ATHR1"),U,2) ; person who released
ATHR2 ; -- ATHR2 node
S VAQASITE=$P(NODE("ATHR2"),U,1)
S VAQADOM=$P(NODE("ATHR2"),U,2)
; -- Clean up
K NODE
; -- Success
Q 0
;
KILLTRN ; -- Kills variables created in TRNDATA
K VAQTRN,VAQCSTAT,VAQPTPTR,VAQSENP,VAQRSTAT
K VAQPTNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQPTID
K VAQRDT,VAQRPER
K VAQADT,VAQAPER
K VAQASITE,VAQADOM
K VAQRSITE,VAQRDOM
QUIT
;
RLSEPAT(TRANPTR) ;GET INFO ON PATIENT RELEASED BY REMOTE FACILITY
;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file (#394.61)
;OUTPUT : name^ssn^dob - Success
; name = Name of patient at remote facility
; ssn = Social security number of patient at remote facility
; (internal format -> without dashes)
; dob = Date of birth of patient at remote facility
; (internal format -> FileMan)
; "" - Error (no info found or bad input)
;
;CHECK INPUT
Q:('$D(^VAT(394.61,(+$G(TRANPTR)),0))) ""
;DECLARE VARIABLES
N TMP,SEGPTR,FIELD,DATAPTR,NAME,SSN,DOB,FOUND
;CHECK CURRENT STATUS - MAKE SURE DATA WAS RELEASED
S TMP=$P($$STATYPE^VAQCON1(TRANPTR,1),"^",1)
Q:((TMP'="VAQ-UNSOL")&(TMP'="VAQ-RSLT")) ""
;GET POINTER TO PDX*MIN SEGMENT
S SEGPTR=+$O(^VAT(394.71,"C","PDX*MIN",0))
Q:('SEGPTR) ""
;INITIALIZE OUTPUT VARIABLES
S (NAME,SSN,DOB)=""
;FIND INFO IN DATA FILE
S (DATAPTR,FOUND)=0
F S DATAPTR=+$O(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGPTR,DATAPTR)) Q:('DATAPTR) D Q:(FOUND=3)
.;VERIFY CORRECTNESS OF X-REF
.Q:((+$G(^VAT(394.62,DATAPTR,"TRNS")))'=TRANPTR)
.S TMP=$G(^VAT(394.62,DATAPTR,0))
.Q:((+$P(TMP,"^",2))'=SEGPTR)
.Q:((+$P(TMP,"^",5)))
.;SEE IF ENTRY IS FOR NAME OR SSN OR DOB
.Q:((+$P(TMP,"^",3))='2)
.S FIELD=+$P(TMP,"^",4)
.Q:((FIELD'=.01)&(FIELD'=.03)&(FIELD'=.09))
.;ONLY ACCEPT FOR SEQUENCE NUMBER 0
.Q:(+$G(^VAT(394.62,DATAPTR,"SQNCE")))
.;GET VALUE, SET APPROPRIATE VARIABLE, AND INCREMENT FOUND COUNT
.S TMP=$G(^VAT(394.62,DATAPTR,"VAL"))
.I (FIELD=.01) S NAME=TMP,FOUND=FOUND+1 Q
.I (FIELD=.03) S DOB=$$DATE^VAQUTL99(TMP) S:(DOB="-1") DOB="" S FOUND=FOUND+1 Q
.I (FIELD=.09) S SSN=$TR(TMP,"-",""),FOUND=FOUND+1 Q
;RETURN RESULTS
Q NAME_"^"_SSN_"^"_DOB
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQUTL92 3653 printed Apr 09, 2024@21:27:17 Page 2
VAQUTL92 ;ALB/JFP,JRP - PDX TRANSACTION Lookup ;01-SEPT-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**6,36**;NOV 17, 1993
+2 ;
TRNDATA(TRNPTR) ; -- Returns nodes in transaction file in local array NODE
+1 ; INPUT: TRNPTR = Pointer to VAQ - TRANSACTION FILE
+2 ; OUTPUT: 0 = Success
+3 ; see variable =
+4 ; -1^Reason = Bad input
+5 ;
+6 ; NOTE: Do KILLTRN to kill off variables created in this
+7 ; function.
+8 ;
+9 if '(+$GET(TRNPTR))
QUIT "-^Did not pass pointer to transaction file"
+10 ; -- Declare variables
+11 KILL NODE
+12 NEW ND,Y
+13 ; -- Main
+14 FOR ND=0,"QRY","ATHR1","ATHR2","RQST1","RQST2"
Begin DoDot:1
+15 SET NODE(ND)=$GET(^VAT(394.61,+TRNPTR,ND))
End DoDot:1
+16 ; -- Define variables
ZERO ; -- ZERO node
+1 SET VAQTRN=$PIECE(NODE(0),U,1)
+2 SET VAQCSTAT=$PIECE(NODE(0),U,2)
+3 SET VAQPTPTR=$PIECE(NODE(0),U,3)
+4 SET VAQSENP=$PIECE(NODE(0),U,4)
+5 SET VAQRSTAT=$PIECE(NODE(0),U,5)
QRY ; -- QRY node
+1 SET VAQPTNM=$PIECE(NODE("QRY"),U,1)
+2 SET VAQISSN=$PIECE(NODE("QRY"),U,2)
+3 SET VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)
+4 SET VAQIDOB=$PIECE(NODE("QRY"),U,3)
+5 SET VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)
+6 SET VAQPTID=$PIECE(NODE("QRY"),U,4)
RQST1 ; -- RQST1 node
+1 SET Y=$PIECE(NODE("RQST1"),U,1)
XECUTE ^DD("DD")
SET VAQRDT=Y
+2 ; person requesting
SET VAQRPER=$PIECE(NODE("RQST1"),U,2)
RQST2 ; -- RQST2 node
+1 SET VAQRSITE=$PIECE(NODE("RQST2"),U,1)
+2 SET VAQRDOM=$PIECE(NODE("RQST2"),U,2)
ATHR1 ; -- ATHR1 node
+1 SET Y=$PIECE(NODE("ATHR1"),U,1)
XECUTE ^DD("DD")
SET VAQADT=Y
+2 ; person who released
SET VAQAPER=$PIECE(NODE("ATHR1"),U,2)
ATHR2 ; -- ATHR2 node
+1 SET VAQASITE=$PIECE(NODE("ATHR2"),U,1)
+2 SET VAQADOM=$PIECE(NODE("ATHR2"),U,2)
+3 ; -- Clean up
+4 KILL NODE
+5 ; -- Success
+6 QUIT 0
+7 ;
KILLTRN ; -- Kills variables created in TRNDATA
+1 KILL VAQTRN,VAQCSTAT,VAQPTPTR,VAQSENP,VAQRSTAT
+2 KILL VAQPTNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQPTID
+3 KILL VAQRDT,VAQRPER
+4 KILL VAQADT,VAQAPER
+5 KILL VAQASITE,VAQADOM
+6 KILL VAQRSITE,VAQRDOM
+7 QUIT
+8 ;
RLSEPAT(TRANPTR) ;GET INFO ON PATIENT RELEASED BY REMOTE FACILITY
+1 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file (#394.61)
+2 ;OUTPUT : name^ssn^dob - Success
+3 ; name = Name of patient at remote facility
+4 ; ssn = Social security number of patient at remote facility
+5 ; (internal format -> without dashes)
+6 ; dob = Date of birth of patient at remote facility
+7 ; (internal format -> FileMan)
+8 ; "" - Error (no info found or bad input)
+9 ;
+10 ;CHECK INPUT
+11 if ('$DATA(^VAT(394.61,(+$GET(TRANPTR)),0)))
QUIT ""
+12 ;DECLARE VARIABLES
+13 NEW TMP,SEGPTR,FIELD,DATAPTR,NAME,SSN,DOB,FOUND
+14 ;CHECK CURRENT STATUS - MAKE SURE DATA WAS RELEASED
+15 SET TMP=$PIECE($$STATYPE^VAQCON1(TRANPTR,1),"^",1)
+16 if ((TMP'="VAQ-UNSOL")&(TMP'="VAQ-RSLT"))
QUIT ""
+17 ;GET POINTER TO PDX*MIN SEGMENT
+18 SET SEGPTR=+$ORDER(^VAT(394.71,"C","PDX*MIN",0))
+19 if ('SEGPTR)
QUIT ""
+20 ;INITIALIZE OUTPUT VARIABLES
+21 SET (NAME,SSN,DOB)=""
+22 ;FIND INFO IN DATA FILE
+23 SET (DATAPTR,FOUND)=0
+24 FOR
SET DATAPTR=+$ORDER(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGPTR,DATAPTR))
if ('DATAPTR)
QUIT
Begin DoDot:1
+25 ;VERIFY CORRECTNESS OF X-REF
+26 if ((+$GET(^VAT(394.62,DATAPTR,"TRNS")))'=TRANPTR)
QUIT
+27 SET TMP=$GET(^VAT(394.62,DATAPTR,0))
+28 if ((+$PIECE(TMP,"^",2))'=SEGPTR)
QUIT
+29 if ((+$PIECE(TMP,"^",5)))
QUIT
+30 ;SEE IF ENTRY IS FOR NAME OR SSN OR DOB
+31 if ((+$PIECE(TMP,"^",3))='2)
QUIT
+32 SET FIELD=+$PIECE(TMP,"^",4)
+33 if ((FIELD'=.01)&(FIELD'=.03)&(FIELD'=.09))
QUIT
+34 ;ONLY ACCEPT FOR SEQUENCE NUMBER 0
+35 if (+$GET(^VAT(394.62,DATAPTR,"SQNCE")))
QUIT
+36 ;GET VALUE, SET APPROPRIATE VARIABLE, AND INCREMENT FOUND COUNT
+37 SET TMP=$GET(^VAT(394.62,DATAPTR,"VAL"))
+38 IF (FIELD=.01)
SET NAME=TMP
SET FOUND=FOUND+1
QUIT
+39 IF (FIELD=.03)
SET DOB=$$DATE^VAQUTL99(TMP)
if (DOB="-1")
SET DOB=""
SET FOUND=FOUND+1
QUIT
+40 IF (FIELD=.09)
SET SSN=$TRANSLATE(TMP,"-","")
SET FOUND=FOUND+1
QUIT
End DoDot:1
if (FOUND=3)
QUIT
+41 ;RETURN RESULTS
+42 QUIT NAME_"^"_SSN_"^"_DOB
