source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXPLIA.m@ 701

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1LEXPLIA ; ISL Problem List In-Active ICD Codes ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4 ; Fixes ICD pointers in the Problem List to In-Active ICD Codes
5 ; or 6 Digit ICD Codes where the Lexicon pointer is greater
6 ; than 2 (source of pointer is the Lexicon) to a valid ICD and
7 ; active ICD Code.
8 ;
9 ; EN^LEXPLIA Entry point to fix in-active ICD
10 ;
11 ; EN2^LEXPLIA(X) Entry point to fix in-active ICD and
12 ; return the number of in-active codes fixed
13 ;
14 ; EN3^LEXPLIA Entry point to to Task EN^LEXPLIA
15 ;
16 Q
17EN ; Entry to fix exact match
18 N LEXCNT S LEXCNT=0 D EM S:$D(ZTQUEUED) ZTREQ="@" Q
19EN2(X) ; Entry to fix exact match and return # fixed
20 N LEXCNT S LEXCNT=0 D EM S X=LEXCNT Q X
21EN3 ; Task EN^LEXPLIA
22 S ZTRTN="EN^LEXPLIA",ZTDESC="In-Active ICD Codes in Prob List # 9000011",ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS K Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN Q
23EM ; Exact match
24 N DA,DIC,DIE,DR,DTOUT,LEXAT,LEXICD,LEXIIA,LEXISO,LEXLEX,LEXNIC,LEXNIP
25 S DA=0 F S DA=$O(^AUPNPROB(DA)) Q:+DA=0 D
26 . S LEXICD=+($P($G(^AUPNPROB(DA,0)),"^",1)) Q:LEXICD'>0 S LEXIIA=+($P($G(^ICD9(LEXICD,0)),"^",9)),LEXISO=$P($G(^ICD9(LEXICD,0)),"^",1) Q:'$L(LEXISO) S LEXLEX=+($P($G(^AUPNPROB(DA,1)),"^",1)) Q:LEXLEX'>2
27 . I $L($P(LEXISO,".",2))>2!(LEXIIA=1) S LEXNIC=$$ICDONE^LEXU(+LEXLEX) Q:LEXNIC="" S LEXNIP=0 S:$L(LEXNIC) LEXNIP=+($O(^ICD9("AB",(LEXNIC_" "),0))) Q:LEXNIP=0 Q:+($P($G(^ICD9(LEXNIP,0)),"^",9))=1 D EDIT
28 Q
29EDIT ; Edit Problem
30 N LEXAT S LEXAT=0 S DA=+($G(DA)) Q:'$D(^AUPNPROB(DA,0)) S LEXNIP=+($G(LEXNIP)) Q:'$D(^ICD9(LEXNIP,0)) S (DIE,DIC)="^AUPNPROB(",DR=".01////^S X=LEXNIP"
31ED2 ; Record is Locked
32 L +^AUPNPROB(DA):1 I '$T,LEXAT'>5 S LEXAT=LEXAT+1 H 2 G ED2
33 G:LEXAT>5 EDQ D ^DIE L -^AUPNPROB(DA)
34EDQ ; Edit Quit
35 I $P($G(^AUPNPROB(DA,0)),"^",1)=LEXNIP S LEXCNT=+($G(LEXCNT))+1
36 Q
Note: See TracBrowser for help on using the repository browser.