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 ---[H[J[2J[HGMPL 5023 printed Dec 13, 2024@02:29:39 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
