source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXPLUP.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 
1LEXPLUP ; ISL Problem List Update 799.9 ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996;Build 1
3 ;
4 ; Fixes ICD code 799.9 for Problems which have a Lexicon pointer
5 ; greater than 2, and which may have been updated in a later version
6 ; (Lexicon term exported without ICD, and later assigned an ICD)
7 ;
8 ; EN^LEXPLUP Entry point to fix updated 799.9s
9 ;
10 ; EN2^LEXPLUP(X) Entry point to fix updated 799.9s and
11 ; returns the number of updated 799.9s fixed
12 ;
13 ; EN3^LEXPLUP Entry point to to Task EN^LEXPLUP
14 ;
15 Q
16EN ; Entry to fix exact match
17 S:$D(ZTQUEUED) ZTREQ="@"
18 N LEXCNT S LEXCNT=0 D UP Q
19EN2(X) ; Entry to fix exact match and return # fixed
20 N LEXCNT S LEXCNT=0 D UP S X=LEXCNT Q X
21EN3 ; Task EN^LEXPLUP
22 S ZTRTN="EN^LEXPLUP",ZTDESC="Update 799.9s in Prob List # 9000011",ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS K Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN Q
23UP ; Exact match
24 N DA,DIC,DIE,DR,DTOUT,LEXAT,LEXICD,LEXISO,LEXLEX,LEXNIC,LEXNIP,LEXUNP,X,Y
25 S LEXUNP=+($O(^ICD9("AB","799.9 ",0))) Q:LEXUNP=0 S DA=0 F S DA=$O(^AUPNPROB(DA)) Q:+DA=0 D
26 . S LEXICD=$P($G(^AUPNPROB(DA,0)),"^",1) Q:LEXICD'=LEXUNP S LEXISO=$P($G(^ICD9(LEXICD,0)),"^",1) Q:LEXISO'=799.9 S LEXLEX=$P($G(^AUPNPROB(DA,1)),"^",1) Q:LEXLEX'>2
27 . S LEXNIC=$$ICDONE^LEXU(+LEXLEX) Q:LEXNIC="" S LEXNIP=0 S:$L(LEXNIC) LEXNIP=+($O(^ICD9("AB",(LEXNIC_" "),0))) Q:LEXNIP=0
28 . I +LEXLEX>2,$D(^LEX(757.01,+LEXLEX,0)),+LEXNIP>0,$D(^ICD9(+LEXNIP,0)) D EDIT
29 Q
30EDIT ; Edit Problem
31 N LEXAT S LEXAT=0,DA=+($G(DA)) Q:'$D(^AUPNPROB(DA,0)) Q:'$D(^AUPNPROB(DA,1)) S LEXNIP=+($G(LEXNIP)) Q:'$D(^ICD9(LEXNIP,0))
32 S (DIE,DIC)="^AUPNPROB(",DR=".01////^S X=LEXNIP"
33ED2 ; Record is Locked
34 L +^AUPNPROB(DA):1 I '$T,LEXAT'>5 S LEXAT=LEXAT+1 H 2 G ED2
35 G:LEXAT>5 EDQ D ^DIE L -^AUPNPROB(DA)
36EDQ ; Edit Quit
37 I $P($G(^AUPNPROB(DA,0)),"^",1)=LEXNIP S LEXCNT=+($G(LEXCNT))+1
38 Q
Note: See TracBrowser for help on using the repository browser.