GMPL.m

GMPL ; SLC/MKB/AJB/TC -- Problem List Driver;09/07/17  13:29

 ;;2.0;Problem List;**3,11,28,42,49**;Aug 25, 1994;Build 43

EN ; -- main entry point for GMPL PROBLEM LIST

 S GMPLUSER=1

 D EN^VALM("GMPL PROBLEM LIST")

 Q

 ;

DE ; -- main entry point for GMPL DATA ENTRY

 K GMPLUSER

 D EN^VALM("GMPL DATA ENTRY")

 Q

 ;

ADD ; -- add a new problem

 S VALMBCK="",GMPCLIN="" K GMPREBLD

 I +$P(GMPDFN,U,4),'$$CKDEAD^GMPLX1($P(GMPDFN,U,4)) G ADDQ

 S:$E(GMPLVIEW("VIEW"))'="S" GMPCLIN=$$CLINIC^GMPLX1("") G:GMPCLIN="^" ADDQ

 S GMPLSLST=$$GET^XPAR(DUZ_";VA(200,","ORQQPL SELECTION LIST",1)

 I 'GMPLSLST,GMPCLIN S GMPLSLST=$$GET^XPAR(+GMPCLIN_";SC(","ORQQPL SELECTION LIST",1) ; if user has no list but clinic does, use clinic list

 I GMPLSLST D  G ADD1

 . S $P(GMPLSLST,U,2)=$P($G(^GMPL(125,+GMPLSLST,0)),U)

 . D EN^VALM("GMPL LIST MENU")

 W @IOF D FULL^VALM1 F  D ADD^GMPL1 Q:$D(GMPQUIT)  S:$D(GMPSAVED) GMPREBLD=1 K DUOUT,DTOUT,GMPSAVED W !!!,">>>  Please enter another problem, or press <return> to exit."

 S VALMBCK="R"

ADD1 I $D(GMPREBLD) D

 . S VALMBCK="R",GMPRINT=1

 . S VALMBG=$S(GMPARAM("REV"):1,VALMCNT<10:1,1:VALMCNT-9)

 . D BUILD^GMPLMGR(.GMPLIST),HDR^GMPLMGR

ADDQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX S:'VALMCC VALMBCK="R"

 Q

 ;

STATUS ; -- inactivate a problem

 S VALMBCK="" G:+$G(GMPCOUNT)'>0 STQ

 I GMPLVIEW("ACT")="I" W $C(7),!!,"Currently displayed problems are already inactive!",! G STQ

 S GMPLSEL=$$SEL^GMPLX("inactivate") G:GMPLSEL="^" STQ

 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

 . I $P(^AUPNPROB(GMPIFN,0),U,12)="I" W !!,$$PROBTEXT^GMPLX(GMPIFN),!,"is already inactive!",! H 2 Q

 . I $P($G(^AUPNPROB(GMPIFN,1)),U,2)="H" W !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has been removed from this patient's problem list!",! H 2 Q

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

 . D STATUS^GMPL1 L -^AUPNPROB(GMPIFN,0)

 I $D(GMPSAVED) D

 . S VALMBCK="R",GMPRINT=1

 . D BUILD^GMPLMGR(.GMPLIST),HDR^GMPLMGR

STQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX S:'VALMCC VALMBCK="R"

 Q

 ;

NOTES ; -- annotate a problem

 S VALMBCK="" G:+$G(GMPCOUNT)'>0 NTQ

 S GMPLNUM=$$SEL1^GMPLX("add comment(s) to") G:GMPLNUM="^" NTQ

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

 I $P($G(^AUPNPROB(GMPIFN,1)),U,2)="H" W !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has been removed from this patient's problem list!",! H 2 G NTQ

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

 D NEWNOTE^GMPL1 I $D(GMPSAVED) D

 . S VALMBCK="R",GMPRINT=1

 . D BUILD^GMPLMGR(.GMPLIST)

 L -^AUPNPROB(GMPIFN,0)

NTQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX S:'VALMCC VALMBCK="R"

 Q

 ;

EDIT ; -- edit allowable fields of a problem

 S VALMBCK="" G:+$G(GMPCOUNT)'>0 EDQ

 S GMPLNUM=$$SEL1^GMPLX("edit") G:GMPLNUM="^" EDQ

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

 ; Code Set Versioning (CSV)

 ; I '$$CODESTS^GMPLX(GMPIFN,DT) W !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has an inactive ICD code.",! H 3 G EDQ

 I $P($G(^AUPNPROB(GMPIFN,1)),U,2)="H" W !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has been removed from this patient's problem list!",! H 2 G EDQ

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

 D EN^VALM("GMPL EDIT PROBLEM")

 I $D(GMPSAVED) D BUILD^GMPLMGR(.GMPLIST),HDR^GMPLMGR S GMPRINT=1

 S VALMBCK="R" L -^AUPNPROB(GMPIFN,0)

EDQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX S:'VALMCC VALMBCK="R"

 Q

 ;

DELETE ; -- delete a problem

 S VALMBCK="" G:+$G(GMPCOUNT)'>0 DELQ

 S GMPLSEL=$$SEL^GMPLX("remove from the list") G:GMPLSEL="^" DELQ

 S GMPLNO=$L(GMPLSEL,",") G:'$$SUREDEL^GMPLEDT2(GMPLNO-1) DELQ

 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

 . I $P($G(^AUPNPROB(GMPIFN,1)),U,2)="H" W !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has already been removed from this patient's problem list!",! H 2 Q

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

 . D DELETE^GMPL1 L -^AUPNPROB(GMPIFN,0)

 I $D(GMPSAVED) D

 . S VALMBCK="R",GMPRINT=1 D BUILD^GMPLMGR(.GMPLIST),HDR^GMPLMGR

DELQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX S:'VALMCC VALMBCK="R"

 Q

 ;

VERIFY ; -- verify a problem

 S VALMBCK="" Q:+$G(GMPCOUNT)'>0

 W !!,"Select the problem(s) you wish to verify as correct."

 S GMPLSEL=$$SEL^GMPLX("mark as verified") G:GMPLSEL="^" VERQ

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

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

 . S GMPIFN=$P($G(^TMP("GMPLIDX",$J,GMPLNUM)),U,2)

 . D:GMPIFN VERIFY^GMPL1

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

VERQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX S:'VALMCC VALMBCK="R"

 Q

 ;

EXPAND ; -- detailed display of a problem

 S VALMBCK="" Q:+$G(GMPCOUNT)'>0

 S GMPLSEL=$$SEL^GMPLX("view") G:GMPLSEL="^" EXPQ

 S GMPLNO=$L(GMPLSEL,",")-1,GMPI=0

 D EN^VALM("GMPL DETAILED DISPLAY")

 S VALMBCK="R"

EXPQ D KILL^GMPLX S VALMSG=$$MSG^GMPLX S:'VALMCC VALMBCK="R"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMPL   5023     printed  Mar 13, 2025@21:34:26                                                                                                                                                                                                        Page 2

GMPL      ; SLC/MKB/AJB/TC -- Problem List Driver;09/07/17  13:29

 +1       ;;2.0;Problem List;**3,11,28,42,49**;Aug 25, 1994;Build 43

EN        ; -- main entry point for GMPL PROBLEM LIST

 +1        SET GMPLUSER=1

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

 +3        QUIT 

 +4       ;

DE        ; -- main entry point for GMPL DATA ENTRY

 +1        KILL GMPLUSER

 +2        DO EN^VALM("GMPL DATA ENTRY")

 +3        QUIT 

 +4       ;

ADD       ; -- add a new problem

 +1        SET VALMBCK=""

           SET GMPCLIN=""

           KILL GMPREBLD

 +2        IF +$PIECE(GMPDFN,U,4)

               IF '$$CKDEAD^GMPLX1($PIECE(GMPDFN,U,4))

                   GOTO ADDQ

 +3        if $EXTRACT(GMPLVIEW("VIEW"))'="S"

               SET GMPCLIN=$$CLINIC^GMPLX1("")

           if GMPCLIN="^"

               GOTO ADDQ

 +4        SET GMPLSLST=$$GET^XPAR(DUZ_";VA(200,","ORQQPL SELECTION LIST",1)

 +5       ; if user has no list but clinic does, use clinic list

           IF 'GMPLSLST

               IF GMPCLIN

                   SET GMPLSLST=$$GET^XPAR(+GMPCLIN_";SC(","ORQQPL SELECTION LIST",1)

 +6        IF GMPLSLST

               Begin DoDot:1

 +7                SET $PIECE(GMPLSLST,U,2)=$PIECE($GET(^GMPL(125,+GMPLSLST,0)),U)

 +8                DO EN^VALM("GMPL LIST MENU")

               End DoDot:1

               GOTO ADD1

 +9        WRITE @IOF

           DO FULL^VALM1

           FOR 

               DO ADD^GMPL1

               if $DATA(GMPQUIT)

                   QUIT 

               if $DATA(GMPSAVED)

                   SET GMPREBLD=1

               KILL DUOUT,DTOUT,GMPSAVED

               WRITE !!!,">>>  Please enter another problem, or press <return> to exit."

 +10       SET VALMBCK="R"

ADD1       IF $DATA(GMPREBLD)

               Begin DoDot:1

 +1                SET VALMBCK="R"

                   SET GMPRINT=1

 +2                SET VALMBG=$SELECT(GMPARAM("REV"):1,VALMCNT<10:1,1:VALMCNT-9)

 +3                DO BUILD^GMPLMGR(.GMPLIST)

                   DO HDR^GMPLMGR

               End DoDot:1

ADDQ       DO KILL^GMPLX

           SET VALMSG=$$MSG^GMPLX

           if 'VALMCC

               SET VALMBCK="R"

 +1        QUIT 

 +2       ;

STATUS    ; -- inactivate a problem

 +1        SET VALMBCK=""

           if +$GET(GMPCOUNT)'>0

               GOTO STQ

 +2        IF GMPLVIEW("ACT")="I"

               WRITE $CHAR(7),!!,"Currently displayed problems are already inactive!",!

               GOTO STQ

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

           if GMPLSEL="^"

               GOTO STQ

 +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                    IF $PIECE(^AUPNPROB(GMPIFN,0),U,12)="I"

                           WRITE !!,$$PROBTEXT^GMPLX(GMPIFN),!,"is already inactive!",!

                           HANG 2

                           QUIT 

 +8                    IF $PIECE($GET(^AUPNPROB(GMPIFN,1)),U,2)="H"

                           WRITE !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has been removed from this patient's problem list!",!

                           HANG 2

                           QUIT 

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

                       IF '$TEST

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

                           HANG 2

                           QUIT 

 +10                   DO STATUS^GMPL1

                       LOCK -^AUPNPROB(GMPIFN,0)

                   End DoDot:1

                   if $DATA(GMPQUIT)

                       QUIT 

 +11       IF $DATA(GMPSAVED)

               Begin DoDot:1

 +12               SET VALMBCK="R"

                   SET GMPRINT=1

 +13               DO BUILD^GMPLMGR(.GMPLIST)

                   DO HDR^GMPLMGR

               End DoDot:1

STQ        DO KILL^GMPLX

           SET VALMSG=$$MSG^GMPLX

           if 'VALMCC

               SET VALMBCK="R"

 +1        QUIT 

 +2       ;

NOTES     ; -- annotate a problem

 +1        SET VALMBCK=""

           if +$GET(GMPCOUNT)'>0

               GOTO NTQ

 +2        SET GMPLNUM=$$SEL1^GMPLX("add comment(s) to")

           if GMPLNUM="^"

               GOTO NTQ

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

           if GMPIFN'>0

               GOTO NTQ

 +4        IF $PIECE($GET(^AUPNPROB(GMPIFN,1)),U,2)="H"

               WRITE !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has been removed from this patient's problem list!",!

               HANG 2

               GOTO NTQ

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

           IF '$TEST

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

               HANG 2

               GOTO NTQ

 +6        DO NEWNOTE^GMPL1

           IF $DATA(GMPSAVED)

               Begin DoDot:1

 +7                SET VALMBCK="R"

                   SET GMPRINT=1

 +8                DO BUILD^GMPLMGR(.GMPLIST)

               End DoDot:1

 +9        LOCK -^AUPNPROB(GMPIFN,0)

NTQ        DO KILL^GMPLX

           SET VALMSG=$$MSG^GMPLX

           if 'VALMCC

               SET VALMBCK="R"

 +1        QUIT 

 +2       ;

EDIT      ; -- edit allowable fields of a problem

 +1        SET VALMBCK=""

           if +$GET(GMPCOUNT)'>0

               GOTO EDQ

 +2        SET GMPLNUM=$$SEL1^GMPLX("edit")

           if GMPLNUM="^"

               GOTO EDQ

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

           if GMPIFN'>0

               GOTO EDQ

 +4       ; Code Set Versioning (CSV)

 +5       ; I '$$CODESTS^GMPLX(GMPIFN,DT) W !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has an inactive ICD code.",! H 3 G EDQ

 +6        IF $PIECE($GET(^AUPNPROB(GMPIFN,1)),U,2)="H"

               WRITE !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has been removed from this patient's problem list!",!

               HANG 2

               GOTO EDQ

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

           IF '$TEST

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

               HANG 2

               GOTO EDQ

 +8        DO EN^VALM("GMPL EDIT PROBLEM")

 +9        IF $DATA(GMPSAVED)

               DO BUILD^GMPLMGR(.GMPLIST)

               DO HDR^GMPLMGR

               SET GMPRINT=1

 +10       SET VALMBCK="R"

           LOCK -^AUPNPROB(GMPIFN,0)

EDQ        DO KILL^GMPLX

           SET VALMSG=$$MSG^GMPLX

           if 'VALMCC

               SET VALMBCK="R"

 +1        QUIT 

 +2       ;

DELETE    ; -- delete a problem

 +1        SET VALMBCK=""

           if +$GET(GMPCOUNT)'>0

               GOTO DELQ

 +2        SET GMPLSEL=$$SEL^GMPLX("remove from the list")

           if GMPLSEL="^"

               GOTO DELQ

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

           if '$$SUREDEL^GMPLEDT2(GMPLNO-1)

               GOTO DELQ

 +4        FOR GMPI=1:1:GMPLNO

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

               IF GMPLNUM

                   Begin DoDot:1

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

                       if GMPIFN'>0

                           QUIT 

 +6                    IF $PIECE($GET(^AUPNPROB(GMPIFN,1)),U,2)="H"

                           WRITE !!,$$PROBTEXT^GMPLX(GMPIFN),!,"has already been removed from this patient's problem list!",!

                           HANG 2

                           QUIT 

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

                       IF '$TEST

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

                           HANG 2

                           QUIT 

 +8                    DO DELETE^GMPL1

                       LOCK -^AUPNPROB(GMPIFN,0)

                   End DoDot:1

                   if $DATA(GMPQUIT)

                       QUIT 

 +9        IF $DATA(GMPSAVED)

               Begin DoDot:1

 +10               SET VALMBCK="R"

                   SET GMPRINT=1

                   DO BUILD^GMPLMGR(.GMPLIST)

                   DO HDR^GMPLMGR

               End DoDot:1

DELQ       DO KILL^GMPLX

           SET VALMSG=$$MSG^GMPLX

           if 'VALMCC

               SET VALMBCK="R"

 +1        QUIT 

 +2       ;

VERIFY    ; -- verify a problem

 +1        SET VALMBCK=""

           if +$GET(GMPCOUNT)'>0

               QUIT 

 +2        WRITE !!,"Select the problem(s) you wish to verify as correct."

 +3        SET GMPLSEL=$$SEL^GMPLX("mark as verified")

           if GMPLSEL="^"

               GOTO VERQ

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

 +7                    if GMPIFN

                           DO VERIFY^GMPL1

                   End DoDot:1

 +8        IF $DATA(GMPSAVED)

               DO BUILD^GMPLMGR(.GMPLIST)

               SET VALMBCK="R"

VERQ       DO KILL^GMPLX

           SET VALMSG=$$MSG^GMPLX

           if 'VALMCC

               SET VALMBCK="R"

 +1        QUIT 

 +2       ;

EXPAND    ; -- detailed display of a problem

 +1        SET VALMBCK=""

           if +$GET(GMPCOUNT)'>0

               QUIT 

 +2        SET GMPLSEL=$$SEL^GMPLX("view")

           if GMPLSEL="^"

               GOTO EXPQ

 +3        SET GMPLNO=$LENGTH(GMPLSEL,",")-1

           SET GMPI=0

 +4        DO EN^VALM("GMPL DETAILED DISPLAY")

 +5        SET VALMBCK="R"

EXPQ       DO KILL^GMPLX

           SET VALMSG=$$MSG^GMPLX

           if 'VALMCC

               SET VALMBCK="R"

 +1        QUIT