GMPLEDT4 ; SLC/MKB/TC -- Problem List Edit actions cont ;09/21/12 08:27
;;2.0;Problem List;**5,43**;Aug 25, 1994;Build 4
TERM ; edit field 1.01
N PROB,TERM,ICD,DUP,Y,DTOUT,GMPQUIT
T1 W !,"PROBLEM: "_$P(GMPFLD(.05),U,2)_"//"
R PROB:DTIME S:'$T DTOUT=1 I $D(DTOUT)!(PROB="^") S GMPQUIT=1 Q
I PROB?1"^".E D JUMP^GMPLEDT3(PROB) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G T1
Q:PROB="" Q:PROB=$P(GMPFLD(.05),U,2) ; no change
I PROB["?" D G T1
. W !!?4,"Enter a description of this problem, up to 80 characters.",!
I PROB="@",'+$G(GMPIFN) D S GMPQUIT=1 Q
.W !!?5,$C(7),$C(7),"This problem has not yet been saved."
.W !?5,"Enter <Q>uit and it will not be added to the list.",!!
.K DIR S DIR("A")="Press RETURN to redisplay the problem text"
.S DIR(0)="E" D ^DIR K DIR
I PROB="@" D DELETE^GMPLEDT2 S:VALMBCK="Q" GMPQUIT=1 Q:$D(GMPQUIT) G T1
T2 ; new text -- pass to look-up
I '$D(GMPLUSER)!($D(GMPLUSER)&('GMPARAM("CLU"))) S GMPFLD(1.01)="",GMPFLD(.05)=U_PROB Q
D SEARCH^GMPLX(.PROB,.Y,"PROBLEM: ","1") ; pass to CLU
S TERM=$G(Y),ICD=$G(Y(1)) I +TERM'>0 S GMPQUIT=1 Q
S DUP=$$DUPL^GMPLX(+GMPDFN,+TERM,PROB)
I DUP,'$$DUPLOK^GMPLX(DUP) W ! G T1
S GMPFLD(1.01)=$S(+TERM>1:TERM,1:""),GMPFLD(.05)=U_PROB
;S GMPFLD(.01)=$S($L(ICD):$O(^ICD9("AB",ICD_" ",0))_U_ICD,1:"")
S GMPFLD(.01)=$S($L(ICD):$P($$CODEN^ICDCODE(ICD,80),"~")_U_ICD,1:"") ; Replacing direct global read to ^ICD9
S:'GMPFLD(.01)!($P(GMPFLD(.01),U)<0) GMPFLD(.01)=$$NOS^GMPLX
Q
;
TEXT(DFLT) ; Enter/edit provider narrative text (no lookup)
N DIR,X,Y,DTOUT
S DIR(0)="FAO^2:80",DIR("A")="PROBLEM: " S:$L(DFLT) DIR("B")=DFLT
S DIR("?")="Enter a description of this problem, up to 80 characters."
D ^DIR S:$D(DTOUT)!(X="^") Y="^" S:'$L(DFLT)&(X="") Y="^"
Q Y
;
NTES ; Edit existing note, display # in XQORNOD(0)
N NUM,NOTE,X,Y,PROMPT,DEFAULT,NT
S NT=$S(GMPVA:7,1:5) S:$D(^XUSEC("GMPL ICD CODE",DUZ)) NT=NT+1
S NUM=+$P(XQORNOD(0),U,3)-NT Q:NUM'>0
S NOTE=GMPFLD(10,NUM),DEFAULT=$P(NOTE,U,3)
S PROMPT="NOTE "_$$EXTDT^GMPLX($P(NOTE,U,5))_": "
D EDNOTE Q:$D(GMPQUIT)
S $P(GMPFLD(10,NUM),U,3)=Y
Q
;
EDNOTE ; Edit note text given PROMPT,DEFAULT (returns X,Y)
N DIR,DTOUT,GMPQUIT S DIR(0)="FAO^1:100",DIR("A")=PROMPT
S:$L(DEFAULT) DIR("B")=DEFAULT
S DIR("?",1)="Enter any text you wish appended to this problem, up to 60 characters"
S DIR("?")="in length. You may append as many comments to a problem as you wish."
ED1 D ^DIR I $D(DTOUT)!(Y="^") S GMPQUIT=1,Y="" Q
I Y?1"^".E D JUMP^GMPLEDT3(Y) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G ED1
Q:Y=DEFAULT I X="@" D Q:$D(GMPQUIT)!(Y="") G ED1
. N DIR,X,DTOUT,DUOUT S DIR(0)="YAO",DIR("B")="NO"
. S DIR("A")=" Are you sure you want to delete this comment? "
. S DIR("?")=" Enter YES to completely remove this comment from this patient's problem."
. W $C(7) D ^DIR I $D(DUOUT)!($D(DTOUT)) S GMPQUIT=1,Y="" Q
. S:Y Y=""
I $L(X)>60 W !!,"Text may not exceed 60 characters!",!,$C(7) S DIR("B")=$E(X,1,60) G ED1
S Y=X
Q
;
RESOLVED ; edit field 1.07
N X,Y,PROMPT,HELPMSG,DEFAULT,ONSET,GMPQUIT S ONSET=+$G(GMPFLD(.13))
S DEFAULT=$G(GMPFLD(1.07)),PROMPT="DATE RESOLVED: "
S HELPMSG="Enter the date this problem became resolved or inactive, as precisely as known."
R1 D DATE^GMPLEDT2 Q:$D(GMPQUIT)!($G(GMPLJUMP))
I Y,ONSET,Y<ONSET W !!,"Date Resolved cannot be prior to the Date of Onset!",$C(7) G R1
S GMPFLD(1.07)=Y S:Y'="" GMPFLD(1.07)=GMPFLD(1.07)_U_$$EXTDT^GMPLX(Y)
Q
;
PRIORITY ; edit field 1.14
N DIR,X,Y,DTOUT,GMPQUIT
S DIR(0)="SAO^A:ACUTE;C:CHRONIC;",DIR("A")=" (A)cute or (C)hronic? "
S:$L($G(GMPFLD(1.14))) DIR("B")=$P(GMPFLD(1.14),U,2)
S DIR("?",1)=" You may further refine the status of this problem by designating it",DIR("?",2)=" as ACUTE or CHRONIC; problems marked as ACUTE will be flagged on the",DIR("?")=" list display with a '*'."
PR1 D ^DIR I $D(DTOUT)!(Y="^") S GMPQUIT=1 Q
I Y?1"^".E D JUMP^GMPLEDT3(Y) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G PR1
S:Y'="" Y=Y_U_$S(Y="A":"ACUTE",1:"CHRONIC")
S GMPFLD(1.14)=Y
Q
GMPLEDT4 ; SLC/MKB/TC -- Problem List Edit actions cont ;09/21/12 08:27
+1 ;;2.0;Problem List;**5,43**;Aug 25, 1994;Build 4
TERM ; edit field 1.01
+1 NEW PROB,TERM,ICD,DUP,Y,DTOUT,GMPQUIT
T1 WRITE !,"PROBLEM: "_$PIECE(GMPFLD(.05),U,2)_"//"
+1 READ PROB:DTIME
IF '$TEST
SET DTOUT=1
IF $DATA(DTOUT)!(PROB="^")
SET GMPQUIT=1
QUIT
+2 IF PROB?1"^".E
DO JUMP^GMPLEDT3(PROB)
IF $DATA(GMPQUIT)!($GET(GMPLJUMP))
QUIT
IF $GET(GMPIFN)
KILL GMPLJUMP
GOTO T1
+3 ; no change
IF PROB=""
QUIT
IF PROB=$PIECE(GMPFLD(.05),U,2)
QUIT
+4 IF PROB["?"
Begin DoDot:1
+5 WRITE !!?4,"Enter a description of this problem, up to 80 characters.",!
End DoDot:1
GOTO T1
+6 IF PROB="@"
IF '+$GET(GMPIFN)
Begin DoDot:1
+7 WRITE !!?5,$CHAR(7),$CHAR(7),"This problem has not yet been saved."
+8 WRITE !?5,"Enter <Q>uit and it will not be added to the list.",!!
+9 KILL DIR
SET DIR("A")="Press RETURN to redisplay the problem text"
+10 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
SET GMPQUIT=1
QUIT
+11 IF PROB="@"
DO DELETE^GMPLEDT2
IF VALMBCK="Q"
SET GMPQUIT=1
IF $DATA(GMPQUIT)
QUIT
GOTO T1
T2 ; new text -- pass to look-up
+1 IF '$DATA(GMPLUSER)!($DATA(GMPLUSER)&('GMPARAM("CLU")))
SET GMPFLD(1.01)=""
SET GMPFLD(.05)=U_PROB
QUIT
+2 ; pass to CLU
DO SEARCH^GMPLX(.PROB,.Y,"PROBLEM: ","1")
+3 SET TERM=$GET(Y)
SET ICD=$GET(Y(1))
IF +TERM'>0
SET GMPQUIT=1
QUIT
+4 SET DUP=$$DUPL^GMPLX(+GMPDFN,+TERM,PROB)
+5 IF DUP
IF '$$DUPLOK^GMPLX(DUP)
WRITE !
GOTO T1
+6 SET GMPFLD(1.01)=$SELECT(+TERM>1:TERM,1:"")
SET GMPFLD(.05)=U_PROB
+7 ;S GMPFLD(.01)=$S($L(ICD):$O(^ICD9("AB",ICD_" ",0))_U_ICD,1:"")
+8 ; Replacing direct global read to ^ICD9
SET GMPFLD(.01)=$SELECT($LENGTH(ICD):$PIECE($$CODEN^ICDCODE(ICD,80),"~")_U_ICD,1:"")
+9 IF 'GMPFLD(.01)!($PIECE(GMPFLD(.01),U)<0)
SET GMPFLD(.01)=$$NOS^GMPLX
+10 QUIT
+11 ;
TEXT(DFLT) ; Enter/edit provider narrative text (no lookup)
+1 NEW DIR,X,Y,DTOUT
+2 SET DIR(0)="FAO^2:80"
SET DIR("A")="PROBLEM: "
IF $LENGTH(DFLT)
SET DIR("B")=DFLT
+3 SET DIR("?")="Enter a description of this problem, up to 80 characters."
+4 DO ^DIR
IF $DATA(DTOUT)!(X="^")
SET Y="^"
IF '$LENGTH(DFLT)&(X="")
SET Y="^"
+5 QUIT Y
+6 ;
NTES ; Edit existing note, display # in XQORNOD(0)
+1 NEW NUM,NOTE,X,Y,PROMPT,DEFAULT,NT
+2 SET NT=$SELECT(GMPVA:7,1:5)
IF $DATA(^XUSEC("GMPL ICD CODE",DUZ))
SET NT=NT+1
+3 SET NUM=+$PIECE(XQORNOD(0),U,3)-NT
IF NUM'>0
QUIT
+4 SET NOTE=GMPFLD(10,NUM)
SET DEFAULT=$PIECE(NOTE,U,3)
+5 SET PROMPT="NOTE "_$$EXTDT^GMPLX($PIECE(NOTE,U,5))_": "
+6 DO EDNOTE
IF $DATA(GMPQUIT)
QUIT
+7 SET $PIECE(GMPFLD(10,NUM),U,3)=Y
+8 QUIT
+9 ;
EDNOTE ; Edit note text given PROMPT,DEFAULT (returns X,Y)
+1 NEW DIR,DTOUT,GMPQUIT
SET DIR(0)="FAO^1:100"
SET DIR("A")=PROMPT
+2 IF $LENGTH(DEFAULT)
SET DIR("B")=DEFAULT
+3 SET DIR("?",1)="Enter any text you wish appended to this problem, up to 60 characters"
+4 SET DIR("?")="in length. You may append as many comments to a problem as you wish."
ED1 DO ^DIR
IF $DATA(DTOUT)!(Y="^")
SET GMPQUIT=1
SET Y=""
QUIT
+1 IF Y?1"^".E
DO JUMP^GMPLEDT3(Y)
IF $DATA(GMPQUIT)!($GET(GMPLJUMP))
QUIT
IF $GET(GMPIFN)
KILL GMPLJUMP
GOTO ED1
+2 IF Y=DEFAULT
QUIT
IF X="@"
Begin DoDot:1
+3 NEW DIR,X,DTOUT,DUOUT
SET DIR(0)="YAO"
SET DIR("B")="NO"
+4 SET DIR("A")=" Are you sure you want to delete this comment? "
+5 SET DIR("?")=" Enter YES to completely remove this comment from this patient's problem."
+6 WRITE $CHAR(7)
DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
SET GMPQUIT=1
SET Y=""
QUIT
+7 IF Y
SET Y=""
End DoDot:1
IF $DATA(GMPQUIT)!(Y="")
QUIT
GOTO ED1
+8 IF $LENGTH(X)>60
WRITE !!,"Text may not exceed 60 characters!",!,$CHAR(7)
SET DIR("B")=$EXTRACT(X,1,60)
GOTO ED1
+9 SET Y=X
+10 QUIT
+11 ;
RESOLVED ; edit field 1.07
+1 NEW X,Y,PROMPT,HELPMSG,DEFAULT,ONSET,GMPQUIT
SET ONSET=+$GET(GMPFLD(.13))
+2 SET DEFAULT=$GET(GMPFLD(1.07))
SET PROMPT="DATE RESOLVED: "
+3 SET HELPMSG="Enter the date this problem became resolved or inactive, as precisely as known."
R1 DO DATE^GMPLEDT2
IF $DATA(GMPQUIT)!($GET(GMPLJUMP))
QUIT
+1 IF Y
IF ONSET
IF Y<ONSET
WRITE !!,"Date Resolved cannot be prior to the Date of Onset!",$CHAR(7)
GOTO R1
+2 SET GMPFLD(1.07)=Y
IF Y'=""
SET GMPFLD(1.07)=GMPFLD(1.07)_U_$$EXTDT^GMPLX(Y)
+3 QUIT
+4 ;
PRIORITY ; edit field 1.14
+1 NEW DIR,X,Y,DTOUT,GMPQUIT
+2 SET DIR(0)="SAO^A:ACUTE;C:CHRONIC;"
SET DIR("A")=" (A)cute or (C)hronic? "
+3 IF $LENGTH($GET(GMPFLD(1.14)))
SET DIR("B")=$PIECE(GMPFLD(1.14),U,2)
+4 SET DIR("?",1)=" You may further refine the status of this problem by designating it"
SET DIR("?",2)=" as ACUTE or CHRONIC; problems marked as ACUTE will be flagged on the"
SET DIR("?")=" list display with a '*'."
PR1 DO ^DIR
IF $DATA(DTOUT)!(Y="^")
SET GMPQUIT=1
QUIT
+1 IF Y?1"^".E
DO JUMP^GMPLEDT3(Y)
IF $DATA(GMPQUIT)!($GET(GMPLJUMP))
QUIT
IF $GET(GMPIFN)
KILL GMPLJUMP
GOTO PR1
+2 IF Y'=""
SET Y=Y_U_$SELECT(Y="A":"ACUTE",1:"CHRONIC")
+3 SET GMPFLD(1.14)=Y
+4 QUIT
