VAQUTL96 ;ALB/JFP - PDX Transaction Lookup ;01-APR-93
;;1.5;PATIENT DATA EXCHANGE;**37**;NOV 17, 1993
;
;
GETTRN(PATIENT) ;-- Return DFN for PDX transaction
; -- Only returns patients patients with results of PDX
; -- This will return the same information that DIC returns in Y
;
N DIC,X,Y,RESULT,USRABORT
N TRNFLAG
;
S USRABORT=-1
S:'$D(PATIENT) PATIENT=""
;
; -- User interface
S DIC(0)="EQMZ"
S DIC("S")="I $$TRN1^VAQUTL96()"
S X=PATIENT
S DIC="^VAT(394.61,"
K ^TMP("BS5",$J)
D ^DIC K DIC,NM,SSN,BS5
K ^TMP("BS5",$J)
;
; -- User abort process
;
Q:$D(DTOUT) USRABORT
Q:$D(DUOUT) USRABORT
Q Y
;
TRN1() ; -- filters out transactions flaged as purged OR exceed life days
S TRNFLAG=$$EXPTRN^VAQUTL97(Y)
I TRNFLAG Q 0
;
N NODE
S NODE=$G(^VAT(394.61,Y,"QRY"))
S NM=$P(NODE,U,1)
Q:NM="" 0
S SSN=$P(NODE,U,2)
Q:SSN="" 0
;S BS5=$E(NM,1,1)_$E(SSN,6,10) ; before patch VAQ*1.5*37
S BS5=$E(NM,1,1)_SSN ; after patch VAQ*1.5*37
;
; -- filters out duplicate entries from multiple cross references
I $D(^TMP("BS5",$J,BS5)) Q 0
S ^TMP("BS5",$J,BS5)=1
Q 1
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQUTL96 1163 printed Nov 22, 2024@17:37:06 Page 2
VAQUTL96 ;ALB/JFP - PDX Transaction Lookup ;01-APR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**37**;NOV 17, 1993
+2 ;
+3 ;
GETTRN(PATIENT) ;-- Return DFN for PDX transaction
+1 ; -- Only returns patients patients with results of PDX
+2 ; -- This will return the same information that DIC returns in Y
+3 ;
+4 NEW DIC,X,Y,RESULT,USRABORT
+5 NEW TRNFLAG
+6 ;
+7 SET USRABORT=-1
+8 if '$DATA(PATIENT)
SET PATIENT=""
+9 ;
+10 ; -- User interface
+11 SET DIC(0)="EQMZ"
+12 SET DIC("S")="I $$TRN1^VAQUTL96()"
+13 SET X=PATIENT
+14 SET DIC="^VAT(394.61,"
+15 KILL ^TMP("BS5",$JOB)
+16 DO ^DIC
KILL DIC,NM,SSN,BS5
+17 KILL ^TMP("BS5",$JOB)
+18 ;
+19 ; -- User abort process
+20 ;
+21 if $DATA(DTOUT)
QUIT USRABORT
+22 if $DATA(DUOUT)
QUIT USRABORT
+23 QUIT Y
+24 ;
TRN1() ; -- filters out transactions flaged as purged OR exceed life days
+1 SET TRNFLAG=$$EXPTRN^VAQUTL97(Y)
+2 IF TRNFLAG
QUIT 0
+3 ;
+4 NEW NODE
+5 SET NODE=$GET(^VAT(394.61,Y,"QRY"))
+6 SET NM=$PIECE(NODE,U,1)
+7 if NM=""
QUIT 0
+8 SET SSN=$PIECE(NODE,U,2)
+9 if SSN=""
QUIT 0
+10 ;S BS5=$E(NM,1,1)_$E(SSN,6,10) ; before patch VAQ*1.5*37
+11 ; after patch VAQ*1.5*37
SET BS5=$EXTRACT(NM,1,1)_SSN
+12 ;
+13 ; -- filters out duplicate entries from multiple cross references
+14 IF $DATA(^TMP("BS5",$JOB,BS5))
QUIT 0
+15 SET ^TMP("BS5",$JOB,BS5)=1
+16 QUIT 1
+17 ;
END ; -- End of code
+1 QUIT
