Last change
on this file since 691 was 613, checked in by George Lilly, 15 years ago |
initial load of WorldVistAEHR
|
File size:
1.1 KB
|
Rev | Line | |
---|
[613] | 1 | VAQUTL96 ;ALB/JFP - PDX Transaction Lookup ;01-APR-93
|
---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;**37**;NOV 17, 1993
|
---|
| 3 | ;
|
---|
| 4 | ;
|
---|
| 5 | GETTRN(PATIENT) ;-- Return DFN for PDX transaction
|
---|
| 6 | ; -- Only returns patients patients with results of PDX
|
---|
| 7 | ; -- This will return the same information that DIC returns in Y
|
---|
| 8 | ;
|
---|
| 9 | N DIC,X,Y,RESULT,USRABORT
|
---|
| 10 | N TRNFLAG
|
---|
| 11 | ;
|
---|
| 12 | S USRABORT=-1
|
---|
| 13 | S:'$D(PATIENT) PATIENT=""
|
---|
| 14 | ;
|
---|
| 15 | ; -- User interface
|
---|
| 16 | S DIC(0)="EQMZ"
|
---|
| 17 | S DIC("S")="I $$TRN1^VAQUTL96()"
|
---|
| 18 | S X=PATIENT
|
---|
| 19 | S DIC="^VAT(394.61,"
|
---|
| 20 | K ^TMP("BS5",$J)
|
---|
| 21 | D ^DIC K DIC,NM,SSN,BS5
|
---|
| 22 | K ^TMP("BS5",$J)
|
---|
| 23 | ;
|
---|
| 24 | ; -- User abort process
|
---|
| 25 | ;
|
---|
| 26 | Q:$D(DTOUT) USRABORT
|
---|
| 27 | Q:$D(DUOUT) USRABORT
|
---|
| 28 | Q Y
|
---|
| 29 | ;
|
---|
| 30 | TRN1() ; -- filters out transactions flaged as purged OR exceed life days
|
---|
| 31 | S TRNFLAG=$$EXPTRN^VAQUTL97(Y)
|
---|
| 32 | I TRNFLAG Q 0
|
---|
| 33 | ;
|
---|
| 34 | N NODE
|
---|
| 35 | S NODE=$G(^VAT(394.61,Y,"QRY"))
|
---|
| 36 | S NM=$P(NODE,U,1)
|
---|
| 37 | Q:NM="" 0
|
---|
| 38 | S SSN=$P(NODE,U,2)
|
---|
| 39 | Q:SSN="" 0
|
---|
| 40 | ;S BS5=$E(NM,1,1)_$E(SSN,6,10) ; before patch VAQ*1.5*37
|
---|
| 41 | S BS5=$E(NM,1,1)_SSN ; after patch VAQ*1.5*37
|
---|
| 42 | ;
|
---|
| 43 | ; -- filters out duplicate entries from multiple cross references
|
---|
| 44 | I $D(^TMP("BS5",$J,BS5)) Q 0
|
---|
| 45 | S ^TMP("BS5",$J,BS5)=1
|
---|
| 46 | Q 1
|
---|
| 47 | ;
|
---|
| 48 | END ; -- End of code
|
---|
| 49 | QUIT
|
---|
Note:
See
TracBrowser
for help on using the repository browser.