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