AUPNSICD ;OHPRD/LAB - Screen Purpose of Visit/ICD9 codes ; 5/1/03 11:52am
 ;;1.0;PCE PATIENT CARE ENCOUNTER;**121,149**;Aug 12, 1996
 ;;93.2;IHS PATIENT DICTIONARIES.;;JUL 01, 1993
 ;
 N ICDSTR,ICDVDT
 ;S ICDSTR=$$ICDDX^ICDCODE(Y,$P(^AUPNVSIT(PXCEVIEN,0),"^",2))
 S ICDSTR=$$ICDDX^ICDCODE(Y,+^AUPNVSIT(PXCEVIEN,0)),ICDVDT=+^AUPNVSIT(PXCEVIEN,0)
 G:$G(DUZ("AG"))="V" VAIN
 ;
 ;I 1 Q:$G(DUZ("AG"))'="I"
EIN ; SCREEN OUT E CODES AND INACTIVE CODES
 ;I $E(^ICD9(Y,0),U,1)'="E",$P(^(0),U,9)=""
 ;I $P(^ICD9(Y,0),U,1)'="E",$P(^(0),U,9)=""
 I $P(ICDSTR,U,2)'="E",$P(ICDSTR,U,10)=1
 G:'$T XIT
SEX ; IF 'USE WITH SEX' FIELD HAS A VALUE CHECK THAT VALUE AGAINST AUPNSEX
 G:'$D(AUPNSEX) AGE
 I $P(^ICD9(Y,0),U,10)=""!($P(^ICD9(Y,0),U,10)=AUPNSEX)
 G:'$T XIT
AGE ; IF THERE IS AGE CRITERIA DATA AVAILABLE CHECK TO SEE THAT IT FITS THE CRITERIA
 ;G:'$D(AUPNDAYS) XIT
 ;G:'$D(^ICD9(Y,9999999)) XIT
 ;I $P(^(9999999),U,1)=""!($P(^(9999999),U,1)<AUPNDAYS)
 ;G:'$T XIT
 ;I $P(^(9999999),U,2)=""!($P(^(9999999),U,2)>AUPNDAYS)
XIT ;
 Q
 ;
VAIN ;SCREEN OUT INACTIVE CODES
 ; E codes are ok in the VA
 ;I $P(^ICD9(Y,0),U,9)'=1
 I $P(ICDSTR,U,10)=1
 Q
 ;