| 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 | 
|---|