| [613] | 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
 | 
|---|