source: WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLCODE.m@ 1720

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1GMPLCODE ; SLC/MKB/AJB -- Problem List ICD Code Utilities ;5/27/94 08:23
2 ;;2.0;Problem List;**28**;Aug 25, 1994
3EN ; -- main entry point for GMPL CODE LIST
4 K GMPLUSER
5 D EN^VALM("GMPL CODE LIST")
6 Q
7 ;
8INIT ; -- 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 ;
19HELP ; -- 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 ;
32EDIT ; -- 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"
42EDQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX
43 Q
44 ;
45ICD(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
Note: See TracBrowser for help on using the repository browser.