- 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 Mar 13, 2025@21:31:33 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
