Routine: GMPLCODE

GMPLCODE ; SLC/MKB/AJB/TC -- Problem List ICD Code Utilities ;09/20/12  13:22

 ;;2.0;Problem List;**28,43**;Aug 25, 1994;Build 4

EN ; -- main entry point for GMPL CODE LIST

 K GMPLUSER

 D EN^VALM("GMPL CODE LIST")

INIT ; -- init variables and list array

 S GMPDFN=$$PAT^GMPLX1 I +GMPDFN'>0 K GMPDFN S VALMQUIT=1 Q

 S GMPVA=$S($G(DUZ("AG"))="V":1,1:0),GMPVAMC=+$G(DUZ(2))

 S (GMPSC,GMPAGTOR,GMPION,GMPGULF)=0 D:GMPVA VADPT^GMPLX1(+GMPDFN)

 S (GMPLVIEW("ACT"),GMPLVIEW("VIEW"))="",GMPLVIEW("PROV")=0

 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

 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)

 D BUILD^GMPLMGR(.GMPLIST)

 S VALMSG=$$MSG^GMPLX

HELP ; -- help code

N X

 W !!?4,"You may take a variety of actions from this prompt.  To update"

 W !?4,"the ICD Code assigned to a problem, you may choose to search"

 W !?4,"either the ICD Diagnosis file or the Clinical Lexicon for a"

 W !?4,"match; the code of the entry you select will be assigned to the"

 W !?4,"current problem in the list.  If you need more information on a"

 W !?4,"problem, select Detailed Display.  To see a listing of"

 W !?4,"actions that facilitate navigating the list, enter '??'."

 W !!,"Press <return> to continue ... " R X:DTIME

 S VALMSG=$$MSG^GMPLX,VALMBCK=$S(VALMCC:"",1:"R")

EDIT ; -- edit field .01

 N GMPLSEL,GMPLNO,GMPI,GMPIFN,GMPLNUM,GMPSAVED,GMPQUIT

 S VALMBCK=$S(VALMCC:"",1:"R")

 S GMPLSEL=$$SEL^GMPLX("code") G:GMPLSEL="^" EDQ

 S GMPLNO=$L(GMPLSEL,",")

 F GMPI=1:1:GMPLNO S GMPLNUM=$P(GMPLSEL,",",GMPI) I GMPLNUM D  Q:$D(GMPQUIT)

 . S GMPIFN=$P($G(^TMP("GMPLIDX",$J,+GMPLNUM)),U,2) Q:GMPIFN'>0

 . L +^AUPNPROB(GMPIFN,0):1 I '$T W $C(7),!!,$$LOCKED^GMPLX,! H 2 Q

 . D ICD(GMPLNUM,GMPIFN) L -^AUPNPROB(GMPIFN,0)

 S:$D(GMPSAVED) VALMBCK="R"

EDQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX

ICD(NUM,IFN) ; -- search ICD Diagnosis file #80

 N X,Y,DIC,DIR,DTOUT,DUOUT,OLD,NEW,DA,DR,DIE,LCNT,CHNGE,GMPQUIT,GMPSAVED

 W !,IFN,!

 D FULL^VALM1 S VALMBCK="R" W !!

 ;S OLD=+$G(^AUPNPROB(IFN,0)),OLD=OLD_U_$P($G(^ICD9(OLD,0)),U)

 S OLD=+$G(^AUPNPROB(IFN,0)),OLD=OLD_U_$$CODEC^ICDCODE(OLD) ; Replacing direct global read to ^ICD9

 S DIR(0)="PAO^ICD9(:QEM",DIR("A")="Enter ICD CODE or DESCRIPTION: "

 S DIR("A",1)="Problem #"_NUM_": "_$$PROBTEXT^GMPLX(IFN)

 S DIR("?")="Enter a new code number or a brief free text description on which to search",DIR("B")=$P(OLD,U,2)

 ; Added for Code Set Versioning (CSV) - screen allows ONLY active codes

 S DIR("S")="I +($$STATCHK^ICDAPIU($$CODEC^ICDCODE(+($G(Y))),DT))>0"

 D ^DIR I $D(DTOUT)!($D(DUOUT)) S GMPQUIT=1 Q

 I X="@" Q:'$D(DIR("B"))  S:$$SURE^GMPLX Y=$$NOS^GMPLX

 I +Y>0,Y'=OLD D  S GMPSAVED=1

 . S NEW=Y,DIE="^AUPNPROB(",DA=IFN,DR=".01////"_+NEW D ^DIE

 . S CHNGE=IFN_"^.01^"_$$HTFM^XLFDT($H)_U_DUZ_U_+OLD_U_+NEW

 . D AUDIT^GMPLX(CHNGE,"")

 . S LCNT=+$G(^TMP("GMPLIDX",$J,NUM))

 . D FLDTEXT^VALM10(LCNT,"ICD",$P(NEW,U,2))

 D BUILD^GMPLMGR(.GMPLIST) S VALMBCK="R"

GMPLCODE  ; SLC/MKB/AJB/TC -- Problem List ICD Code Utilities ;09/20/12  13:22

 +1       ;;2.0;Problem List;**28,43**;Aug 25, 1994;Build 4

EN        ; -- main entry point for GMPL CODE LIST

 +1        KILL GMPLUSER

 +2        DO EN^VALM("GMPL CODE LIST")

 +3        QUIT

 +4       ;

INIT      ; -- init variables and list array

 +1        SET GMPDFN=$$PAT^GMPLX1

           IF +GMPDFN'>0

               KILL GMPDFN

               SET VALMQUIT=1

               QUIT

 +2        SET GMPVA=$SELECT($GET(DUZ("AG"))="V":1,1:0)

           SET GMPVAMC=+$GET(DUZ(2))

 +3        SET (GMPSC,GMPAGTOR,GMPION,GMPGULF)=0

           IF GMPVA

               DO VADPT^GMPLX1(+GMPDFN)

 +4        SET (GMPLVIEW("ACT"),GMPLVIEW("VIEW"))=""

           SET GMPLVIEW("PROV")=0

 +5        SET X=$GET(^GMPL(125.99,1,0))

           SET GMPARAM("VER")=+$PIECE(X,U,2)

           SET GMPARAM("PRT")=+$PIECE(X,U,3)

           SET GMPARAM("CLU")=+$PIECE(X,U,4)

           SET GMPARAM("REV")=$SELECT($PIECE(X,U,5)="R":1,1:0)

           KILL X

 +6        DO GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)

 +7        DO BUILD^GMPLMGR(.GMPLIST)

 +8        SET VALMSG=$$MSG^GMPLX

 +9        QUIT

 +10      ;

HELP      ; -- help code

 +1        NEW X

 +2        WRITE !!?4,"You may take a variety of actions from this prompt.  To update"

 +3        WRITE !?4,"the ICD Code assigned to a problem, you may choose to search"

 +4        WRITE !?4,"either the ICD Diagnosis file or the Clinical Lexicon for a"

 +5        WRITE !?4,"match; the code of the entry you select will be assigned to the"

 +6        WRITE !?4,"current problem in the list.  If you need more information on a"

 +7        WRITE !?4,"problem, select Detailed Display.  To see a listing of"

 +8        WRITE !?4,"actions that facilitate navigating the list, enter '??'."

 +9        WRITE !!,"Press <return> to continue ... "

           READ X:DTIME

 +10       SET VALMSG=$$MSG^GMPLX

           SET VALMBCK=$SELECT(VALMCC:"",1:"R")

 +11       QUIT

 +12      ;

EDIT      ; -- edit field .01

 +1        NEW GMPLSEL,GMPLNO,GMPI,GMPIFN,GMPLNUM,GMPSAVED,GMPQUIT

 +2        SET VALMBCK=$SELECT(VALMCC:"",1:"R")

 +3        SET GMPLSEL=$$SEL^GMPLX("code")

           IF GMPLSEL="^"

               GOTO EDQ

 +4        SET GMPLNO=$LENGTH(GMPLSEL,",")

 +5        FOR GMPI=1:1:GMPLNO

               SET GMPLNUM=$PIECE(GMPLSEL,",",GMPI)

               IF GMPLNUM

                   Begin DoDot:1

 +6                    SET GMPIFN=$PIECE($GET(^TMP("GMPLIDX",$JOB,+GMPLNUM)),U,2)

                       IF GMPIFN'>0

                           QUIT

 +7                    LOCK +^AUPNPROB(GMPIFN,0):1

                       IF '$TEST

                           WRITE $CHAR(7),!!,$$LOCKED^GMPLX,!

                           HANG 2

                           QUIT

 +8                    DO ICD(GMPLNUM,GMPIFN)

                       LOCK -^AUPNPROB(GMPIFN,0)

                   End DoDot:1

                   IF $DATA(GMPQUIT)

                       QUIT

 +9        IF $DATA(GMPSAVED)

               SET VALMBCK="R"

EDQ        DO KILL^GMPLX

           SET VALMSG=$$MSG^GMPLX

 +1        QUIT

 +2       ;

ICD(NUM,IFN) ; -- search ICD Diagnosis file #80

 +1        NEW X,Y,DIC,DIR,DTOUT,DUOUT,OLD,NEW,DA,DR,DIE,LCNT,CHNGE,GMPQUIT,GMPSAVED

 +2        WRITE !,IFN,!

 +3        DO FULL^VALM1

           SET VALMBCK="R"

           WRITE !!

 +4       ;S OLD=+$G(^AUPNPROB(IFN,0)),OLD=OLD_U_$P($G(^ICD9(OLD,0)),U)

 +5       ; Replacing direct global read to ^ICD9

           SET OLD=+$GET(^AUPNPROB(IFN,0))

           SET OLD=OLD_U_$$CODEC^ICDCODE(OLD)

 +6        SET DIR(0)="PAO^ICD9(:QEM"

           SET DIR("A")="Enter ICD CODE or DESCRIPTION: "

 +7        SET DIR("A",1)="Problem #"_NUM_": "_$$PROBTEXT^GMPLX(IFN)

 +8        SET DIR("?")="Enter a new code number or a brief free text description on which to search"

           SET DIR("B")=$PIECE(OLD,U,2)

 +9       ; Added for Code Set Versioning (CSV) - screen allows ONLY active codes

 +10       SET DIR("S")="I +($$STATCHK^ICDAPIU($$CODEC^ICDCODE(+($G(Y))),DT))>0"

 +11       DO ^DIR

           IF $DATA(DTOUT)!($DATA(DUOUT))

               SET GMPQUIT=1

               QUIT

 +12       IF X="@"

               IF '$DATA(DIR("B"))

                   QUIT

               IF $$SURE^GMPLX

                   SET Y=$$NOS^GMPLX

 +13       IF +Y>0

               IF Y'=OLD

                   Begin DoDot:1

 +14                   SET NEW=Y

                       SET DIE="^AUPNPROB("

                       SET DA=IFN

                       SET DR=".01////"_+NEW

                       DO ^DIE

 +15                   SET CHNGE=IFN_"^.01^"_$$HTFM^XLFDT($HOROLOG)_U_DUZ_U_+OLD_U_+NEW

 +16                   DO AUDIT^GMPLX(CHNGE,"")

 +17                   SET LCNT=+$GET(^TMP("GMPLIDX",$JOB,NUM))

 +18                   DO FLDTEXT^VALM10(LCNT,"ICD",$PIECE(NEW,U,2))

                   End DoDot:1

                   SET GMPSAVED=1

 +19       DO BUILD^GMPLMGR(.GMPLIST)

           SET VALMBCK="R"

 +20       QUIT

GMPLCODE.m