1 | GMPLCODE ; SLC/MKB/AJB -- Problem List ICD Code Utilities ;5/27/94 08:23
|
---|
2 | ;;2.0;Problem List;**28**;Aug 25, 1994
|
---|
3 | EN ; -- main entry point for GMPL CODE LIST
|
---|
4 | K GMPLUSER
|
---|
5 | D EN^VALM("GMPL CODE LIST")
|
---|
6 | Q
|
---|
7 | ;
|
---|
8 | INIT ; -- init variables and list array
|
---|
9 | S GMPDFN=$$PAT^GMPLX1 I +GMPDFN'>0 K GMPDFN S VALMQUIT=1 Q
|
---|
10 | S GMPVA=$S($G(DUZ("AG"))="V":1,1:0),GMPVAMC=+$G(DUZ(2))
|
---|
11 | S (GMPSC,GMPAGTOR,GMPION,GMPGULF)=0 D:GMPVA VADPT^GMPLX1(+GMPDFN)
|
---|
12 | S (GMPLVIEW("ACT"),GMPLVIEW("VIEW"))="",GMPLVIEW("PROV")=0
|
---|
13 | S X=$G(^GMPL(125.99,1,0)),GMPARAM("VER")=+$P(X,U,2),GMPARAM("PRT")=+$P(X,U,3),GMPARAM("CLU")=+$P(X,U,4),GMPARAM("REV")=$S($P(X,U,5)="R":1,1:0) K X
|
---|
14 | D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
|
---|
15 | D BUILD^GMPLMGR(.GMPLIST)
|
---|
16 | S VALMSG=$$MSG^GMPLX
|
---|
17 | Q
|
---|
18 | ;
|
---|
19 | HELP ; -- help code
|
---|
20 | N X
|
---|
21 | W !!?4,"You may take a variety of actions from this prompt. To update"
|
---|
22 | W !?4,"the ICD Code assigned to a problem, you may choose to search"
|
---|
23 | W !?4,"either the ICD Diagnosis file or the Clinical Lexicon for a"
|
---|
24 | W !?4,"match; the code of the entry you select will be assigned to the"
|
---|
25 | W !?4,"current problem in the list. If you need more information on a"
|
---|
26 | W !?4,"problem, select Detailed Display. To see a listing of"
|
---|
27 | W !?4,"actions that facilitate navigating the list, enter '??'."
|
---|
28 | W !!,"Press <return> to continue ... " R X:DTIME
|
---|
29 | S VALMSG=$$MSG^GMPLX,VALMBCK=$S(VALMCC:"",1:"R")
|
---|
30 | Q
|
---|
31 | ;
|
---|
32 | EDIT ; -- edit field .01
|
---|
33 | N GMPLSEL,GMPLNO,GMPI,GMPIFN,GMPLNUM,GMPSAVED
|
---|
34 | S VALMBCK=$S(VALMCC:"",1:"R")
|
---|
35 | S GMPLSEL=$$SEL^GMPLX("code") G:GMPLSEL="^" EDQ
|
---|
36 | S GMPLNO=$L(GMPLSEL,",")
|
---|
37 | F GMPI=1:1:GMPLNO S GMPLNUM=$P(GMPLSEL,",",GMPI) I GMPLNUM D Q:$D(GMPQUIT)
|
---|
38 | . S GMPIFN=$P($G(^TMP("GMPLIDX",$J,+GMPLNUM)),U,2) Q:GMPIFN'>0
|
---|
39 | . L +^AUPNPROB(GMPIFN,0):1 I '$T W $C(7),!!,$$LOCKED^GMPLX,! H 2 Q
|
---|
40 | . D ICD(GMPLNUM,GMPIFN) L -^AUPNPROB(GMPIFN,0)
|
---|
41 | S:$D(GMPSAVED) VALMBCK="R"
|
---|
42 | EDQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX
|
---|
43 | Q
|
---|
44 | ;
|
---|
45 | ICD(NUM,IFN) ; -- search ICD Diagnosis file #80
|
---|
46 | N X,Y,DIC,DIR,OLD,NEW,DA,DR,DIE,LCNT,CHNGE
|
---|
47 | W !,IFN,!
|
---|
48 | D FULL^VALM1 S VALMBCK="R" W !!
|
---|
49 | S OLD=+$G(^AUPNPROB(IFN,0)),OLD=OLD_U_$P($G(^ICD9(OLD,0)),U)
|
---|
50 | S DIR(0)="PAO^ICD9(:QEM",DIR("A")="Enter ICD CODE or DESCRIPTION: "
|
---|
51 | S DIR("A",1)="Problem #"_NUM_": "_$$PROBTEXT^GMPLX(IFN)
|
---|
52 | S DIR("?")="Enter a new code number or a brief free text description on which to search",DIR("B")=$P(OLD,U,2)
|
---|
53 | ; Added for Code Set Versioning (CSV) - screen allows ONLY active codes
|
---|
54 | S DIR("S")="I +($$STATCHK^ICDAPIU($$CODEC^ICDCODE(+($G(Y))),DT))>0"
|
---|
55 | D ^DIR I $D(DTOUT)!($D(DUOUT)) S GMPQUIT=1 Q
|
---|
56 | I X="@" Q:'$D(DIR("B")) S:$$SURE^GMPLX Y=$$NOS^GMPLX
|
---|
57 | I +Y>0,Y'=OLD D S GMPSAVED=1
|
---|
58 | . S NEW=Y,DIE="^AUPNPROB(",DA=IFN,DR=".01////"_+NEW D ^DIE
|
---|
59 | . S CHNGE=IFN_"^.01^"_$$HTFM^XLFDT($H)_U_DUZ_U_+OLD_U_+NEW
|
---|
60 | . D AUDIT^GMPLX(CHNGE,"")
|
---|
61 | . S LCNT=+$G(^TMP("GMPLIDX",$J,NUM))
|
---|
62 | . D FLDTEXT^VALM10(LCNT,"ICD",$P(NEW,U,2))
|
---|
63 | D BUILD^GMPLMGR(.GMPLIST) S VALMBCK="R"
|
---|
64 | Q
|
---|