| 1 | AUPNSICD ;OHPRD/LAB - Screen Purpose of Visit/ICD9 codes ; 5/1/03 11:52am
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**121,149**;Aug 12, 1996
|
|---|
| 3 | ;;93.2;IHS PATIENT DICTIONARIES.;;JUL 01, 1993
|
|---|
| 4 | ;
|
|---|
| 5 | N ICDSTR,ICDVDT
|
|---|
| 6 | ;S ICDSTR=$$ICDDX^ICDCODE(Y,$P(^AUPNVSIT(PXCEVIEN,0),"^",2))
|
|---|
| 7 | S ICDSTR=$$ICDDX^ICDCODE(Y,+^AUPNVSIT(PXCEVIEN,0)),ICDVDT=+^AUPNVSIT(PXCEVIEN,0)
|
|---|
| 8 | G:$G(DUZ("AG"))="V" VAIN
|
|---|
| 9 | ;
|
|---|
| 10 | ;I 1 Q:$G(DUZ("AG"))'="I"
|
|---|
| 11 | EIN ; SCREEN OUT E CODES AND INACTIVE CODES
|
|---|
| 12 | ;I $E(^ICD9(Y,0),U,1)'="E",$P(^(0),U,9)=""
|
|---|
| 13 | ;I $P(^ICD9(Y,0),U,1)'="E",$P(^(0),U,9)=""
|
|---|
| 14 | I $P(ICDSTR,U,2)'="E",$P(ICDSTR,U,10)=1
|
|---|
| 15 | G:'$T XIT
|
|---|
| 16 | SEX ; IF 'USE WITH SEX' FIELD HAS A VALUE CHECK THAT VALUE AGAINST AUPNSEX
|
|---|
| 17 | G:'$D(AUPNSEX) AGE
|
|---|
| 18 | I $P(^ICD9(Y,0),U,10)=""!($P(^ICD9(Y,0),U,10)=AUPNSEX)
|
|---|
| 19 | G:'$T XIT
|
|---|
| 20 | AGE ; IF THERE IS AGE CRITERIA DATA AVAILABLE CHECK TO SEE THAT IT FITS THE CRITERIA
|
|---|
| 21 | ;G:'$D(AUPNDAYS) XIT
|
|---|
| 22 | ;G:'$D(^ICD9(Y,9999999)) XIT
|
|---|
| 23 | ;I $P(^(9999999),U,1)=""!($P(^(9999999),U,1)<AUPNDAYS)
|
|---|
| 24 | ;G:'$T XIT
|
|---|
| 25 | ;I $P(^(9999999),U,2)=""!($P(^(9999999),U,2)>AUPNDAYS)
|
|---|
| 26 | XIT ;
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | VAIN ;SCREEN OUT INACTIVE CODES
|
|---|
| 30 | ; E codes are ok in the VA
|
|---|
| 31 | ;I $P(^ICD9(Y,0),U,9)'=1
|
|---|
| 32 | I $P(ICDSTR,U,10)=1
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
