source: WorldVistAEHR/trunk/r/IHS_ROUTINES-AUP/AUPNSICD.m@ 1261

Last change on this file since 1261 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 1.1 KB
Line 
1AUPNSICD ;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"
11EIN ; 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
16SEX ; 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
20AGE ; 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)
26XIT ;
27 Q
28 ;
29VAIN ;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 ;
Note: See TracBrowser for help on using the repository browser.