GMPLEDT1 ; SLC/MKB/KER/AJB/TC -- Edit Problem List fields ;08/27/14 07:57
;;2.0;Problem List;**17,20,26,28,35,42,45**;Aug 25, 1994;Build 53
;
; External References
; DBIA 10006 ^DIC
; DBIA 10026 ^DIR
; DBIA 341 DIS^SDROUT2
; ICR 5699 $$ICDDATA^ICDXCODE
; ICR 5747 $$CODECS^ICDEX
;
ONSET ; Edit Date of Onset - field .13
N X,Y,ENTERED,PROMPT,HELPMSG,DEFAULT
S ENTERED=$S($G(GMPFLD(.08)):+GMPFLD(.08),1:DT),DEFAULT=$G(GMPFLD(.13))
S PROMPT="DATE OF ONSET: ",HELPMSG="Enter the date this problem was first observed, as precisely as known."
O1 ; Get Date of Onset
D DATE^GMPLEDT2 Q:$D(GMPQUIT)!($G(GMPLJUMP))
I Y>ENTERED W !!,"Date of Onset cannot be later than the date the problem was entered!",$C(7) G O1
I +$P(GMPDFN,U,4),Y>$P(GMPDFN,U,4) W !!,"Date of Onset cannot be later than the date of death!",$C(7) G O1
S GMPFLD(.13)=Y S:Y'="" GMPFLD(.13)=GMPFLD(.13)_U_$$EXTDT^GMPLX(Y)
Q
STATUS ; Edit Status - field .12
; Then Edit Date Resolved - Field 1.07, if inactive
N DIR,X,Y,DTOUT
S DIR(0)="9000011,.12"
S:$L($G(GMPFLD(.12))) DIR("B")=$P(GMPFLD(.12),U,2)
ST1 ; Get Status
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 ST1
S:Y'="" Y=Y_U_$S(Y="A":"ACTIVE",1:"INACTIVE") S GMPFLD(.12)=Y
S:$E(Y)'="I" GMPFLD(1.07)="" S:$E(Y)'="A" GMPFLD(1.14)=""
D:$E(GMPFLD(.12))="I" RESOLVED^GMPLEDT4
D:$E(GMPFLD(.12))="A" PRIORITY^GMPLEDT4
Q
RECORDED ; Edit Date Recorded - field 1.09
N X,Y,PROMPT,HELPMSG,DEFAULT,ENTERED
S ENTERED=$S($G(GMPFLD(.08)):+GMPFLD(.08),1:DT),DEFAULT=$G(GMPFLD(1.09))
S PROMPT="DATE RECORDED: ",HELPMSG="Enter the date this problem was first recorded, as precisely as known."
RC1 ; Get Date
D DATE^GMPLEDT2 Q:$D(GMPQUIT)!($G(GMPLJUMP))
I Y>ENTERED W !!,"Date Recorded cannot be later than the problem was entered!",$C(7) G RC1
S GMPFLD(1.09)=Y S:Y'="" GMPFLD(1.09)=GMPFLD(1.09)_U_$$EXTDT^GMPLX(Y)
Q
SC ; Edit Service Connected - field 1.1
N DFN,DIR,X,Y,DTOUT
;
; The following allows changing a problem's SC/NSC to
; NSC if there is no SC on file for patient and Problem
; original SC was set to "YES"
;
I +$G(GMPORIG(1.1))=1 D
. W !!,">>> Currently known service-connection data for "_$P(GMPDFN,U,2)_":"
ELSE Q:'GMPSC
S DFN=+GMPDFN D DIS^SDROUT2
I +GMPSC=0,+$G(GMPORIG(1.1))=1 D
. S DIR("A")="Patient has no service-connected condition !! "
. S DIR("B")="NO"
ELSE D
. S DIR("A")="Is this problem related to a service-connected condition? "
. S:$L($G(GMPFLD(1.1))) DIR("B")=$P(GMPFLD(1.1),U,2) W !
S DIR("?",1)="If this problem is due to a service-connected condition, enter YES;",DIR("?")="press <return> and leave blank if this is unknown.",DIR(0)="YAO"
SC1 ; Get Service Connection
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 SC1
I X="@" G:'$$SURE^GMPLX SC1 S Y=""
S GMPFLD(1.1)=Y S:Y'="" GMPFLD(1.1)=GMPFLD(1.1)_U_$S(Y:"YES",1:"NO")
Q
SP ; Edit Exposures/Conditions
; Agent Orange - field 1.11
; Ionizing Radiation - field 1.12
; Persian Gulf/Environmental Contaminants - field 1.13
; Head and/or Neck Cancer - field 1.15
; Military Sexual Trauma - field 1.16
; Combat Vet - field 1.17
; SHAD - field 1.18
G SPEXP^GMPLEDT2
Q
SOURCE ; Edit Service - field 1.06
; or Clinic - field 1.08
N DIC,DTOUT,X,Y,HELPMSG,PROMPT,DEFAULT,VIEW S VIEW=$E(GMPLVIEW("VIEW"))
S DIC=$S(VIEW="S":"^DIC(49,",1:"^SC("),DIC(0)="EMQ"
S DIC("S")="I $P(^(0),U,"_$S(VIEW="S":9,1:3)_")=""C"""
I VIEW="S" S PROMPT="SERVICE: ",DEFAULT=$P(GMPFLD(1.06),U,2)
E S PROMPT="CLINIC: ",DEFAULT=$P(GMPFLD(1.08),U,2)
S HELPMSG="Enter the clinic"_$S(VIEW="S":"al service",1:"")_" to be associated with this problem."
S1 ; Get Service/Clinic
W !,PROMPT_$S($L(DEFAULT):DEFAULT_"//",1:"")
R X:DTIME S:'$T X="^",DTOUT=1 S:X="^" GMPQUIT=1 Q:(X="^")!(X="")
I X?1"^".E D JUMP^GMPLEDT3(X) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G S1
I X="?" W !!,HELPMSG,! G S1
I X["??" D @("LIST"_$S(VIEW="S":"SERV",1:"CLIN")_"^GMPLMGR1") W !,HELPMSG G S1
I X="@" G:'$$SURE^GMPLX S1 S Y="" G SQ
D ^DIC I Y'>0 W !?5,"Only clinic"_$S(VIEW="S":"al service",1:"")_"s are allowed!",! G S1
SQ ; Quit Service/Clinic
S:VIEW'="S" GMPFLD(1.08)=Y S:VIEW="S" GMPFLD(1.06)=Y
Q
AUTHOR ; Edit Recording Provider - field 1.04
N X,Y,PROMPT,HELPMSG,DEFAULT S PROMPT="RECORDING PROVIDER: "
S DEFAULT=$G(GMPFLD(1.04)),HELPMSG="Enter the name of the provider responsible for the recording of this data."
D NPERSON^GMPLEDT2 Q:$D(GMPQUIT)!($G(GMPLJUMP))
S GMPFLD(1.04)=$S(+Y>0:Y,1:"")
Q
PROV ; Edit Responsible Provider - field 1.05
N X,Y,PROMPT,DEFAULT,HELPMSG S DEFAULT=$G(GMPFLD(1.05))
S PROMPT="PROVIDER: ",HELPMSG="Enter the name of the local provider treating this problem."
D NPERSON^GMPLEDT2 Q:$D(GMPQUIT)!($G(GMPLJUMP))
S GMPFLD(1.05)=$S(+Y>0:Y,1:"")
Q
ICD ; Edit ICD Code - field .01
N DIC,DIR,X,Y,DTOUT
ICD0 ; Prompt for ICD Code
K DIR S DIR(0)="FAO^2:6",DIR("A")="ICD CODE: "
S:($P($G(GMPFLD(.01)),U,2)="799.9")!($P($G(GMPFLD(.01)),U,2)="R69.") DIR("A")=IORVON_"ICD CODE: "
S:+$G(GMPFLD(.01)) DIR("B")=$P(GMPFLD(.01),U,2)
S DIR("?")="Enter the ICD code to be associated with this problem"
ICD1 ; Get ICD Code
D ^DIR W IORVOFF 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 ICD1
I X="@" W !!,"ICD Code may not be deleted!",!,$C(7) G ICD1
Q:X="" Q:$P($G(GMPFLD(.01)),U,2)=Y
S DIC=80,DIC(0)="EQM" D ^DIC G:Y'>0 ICD0
S GMPFLD(.01)=Y
Q
NOTE ; Attach a note to problem - field 11
N X,Y,I,DEFAULT,PROMPT,DONE,NXT,NCNT,GMPLCPTR S (I,NCNT,DONE)=0
F D Q:$D(GMPQUIT)!($G(GMPLJUMP))!DONE
. S NXT=$O(GMPFLD(10,"NEW",I)) S:'NXT NXT=I+1
. S I=NXT,NCNT=NCNT+1
. S PROMPT=$S(NCNT=1:"",1:"ANOTHER ")_"COMMENT"_$S(NCNT=1:" (<200 char): ",1:": "),DEFAULT=$G(GMPFLD(10,"NEW",I))
. D EDNOTE^GMPLEDT4 Q:$D(GMPQUIT)!($G(GMPLJUMP))
. I X="@" K GMPFLD(10,"NEW",I) Q
. I Y="" S DONE=1 Q
. S GMPFLD(10,"NEW",I)=Y
Q
TERM ; Edit Problem - field 1.01
G TERM^GMPLEDT4
Q
Q ; No Editing
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLEDT1 6257 printed Sep 23, 2025@20:06:08 Page 2
GMPLEDT1 ; SLC/MKB/KER/AJB/TC -- Edit Problem List fields ;08/27/14 07:57
+1 ;;2.0;Problem List;**17,20,26,28,35,42,45**;Aug 25, 1994;Build 53
+2 ;
+3 ; External References
+4 ; DBIA 10006 ^DIC
+5 ; DBIA 10026 ^DIR
+6 ; DBIA 341 DIS^SDROUT2
+7 ; ICR 5699 $$ICDDATA^ICDXCODE
+8 ; ICR 5747 $$CODECS^ICDEX
+9 ;
ONSET ; Edit Date of Onset - field .13
+1 NEW X,Y,ENTERED,PROMPT,HELPMSG,DEFAULT
+2 SET ENTERED=$SELECT($GET(GMPFLD(.08)):+GMPFLD(.08),1:DT)
SET DEFAULT=$GET(GMPFLD(.13))
+3 SET PROMPT="DATE OF ONSET: "
SET HELPMSG="Enter the date this problem was first observed, as precisely as known."
O1 ; Get Date of Onset
+1 DO DATE^GMPLEDT2
if $DATA(GMPQUIT)!($GET(GMPLJUMP))
QUIT
+2 IF Y>ENTERED
WRITE !!,"Date of Onset cannot be later than the date the problem was entered!",$CHAR(7)
GOTO O1
+3 IF +$PIECE(GMPDFN,U,4)
IF Y>$PIECE(GMPDFN,U,4)
WRITE !!,"Date of Onset cannot be later than the date of death!",$CHAR(7)
GOTO O1
+4 SET GMPFLD(.13)=Y
if Y'=""
SET GMPFLD(.13)=GMPFLD(.13)_U_$$EXTDT^GMPLX(Y)
+5 QUIT
STATUS ; Edit Status - field .12
+1 ; Then Edit Date Resolved - Field 1.07, if inactive
+2 NEW DIR,X,Y,DTOUT
+3 SET DIR(0)="9000011,.12"
+4 if $LENGTH($GET(GMPFLD(.12)))
SET DIR("B")=$PIECE(GMPFLD(.12),U,2)
ST1 ; Get Status
+1 DO ^DIR
IF $DATA(DTOUT)!(Y="^")
SET GMPQUIT=1
QUIT
+2 IF Y?1"^".E
DO JUMP^GMPLEDT3(Y)
if $DATA(GMPQUIT)!($GET(GMPLJUMP))
QUIT
if $GET(GMPIFN)
KILL GMPLJUMP
GOTO ST1
+3 if Y'=""
SET Y=Y_U_$SELECT(Y="A":"ACTIVE",1:"INACTIVE")
SET GMPFLD(.12)=Y
+4 if $EXTRACT(Y)'="I"
SET GMPFLD(1.07)=""
if $EXTRACT(Y)'="A"
SET GMPFLD(1.14)=""
+5 if $EXTRACT(GMPFLD(.12))="I"
DO RESOLVED^GMPLEDT4
+6 if $EXTRACT(GMPFLD(.12))="A"
DO PRIORITY^GMPLEDT4
+7 QUIT
RECORDED ; Edit Date Recorded - field 1.09
+1 NEW X,Y,PROMPT,HELPMSG,DEFAULT,ENTERED
+2 SET ENTERED=$SELECT($GET(GMPFLD(.08)):+GMPFLD(.08),1:DT)
SET DEFAULT=$GET(GMPFLD(1.09))
+3 SET PROMPT="DATE RECORDED: "
SET HELPMSG="Enter the date this problem was first recorded, as precisely as known."
RC1 ; Get Date
+1 DO DATE^GMPLEDT2
if $DATA(GMPQUIT)!($GET(GMPLJUMP))
QUIT
+2 IF Y>ENTERED
WRITE !!,"Date Recorded cannot be later than the problem was entered!",$CHAR(7)
GOTO RC1
+3 SET GMPFLD(1.09)=Y
if Y'=""
SET GMPFLD(1.09)=GMPFLD(1.09)_U_$$EXTDT^GMPLX(Y)
+4 QUIT
SC ; Edit Service Connected - field 1.1
+1 NEW DFN,DIR,X,Y,DTOUT
+2 ;
+3 ; The following allows changing a problem's SC/NSC to
+4 ; NSC if there is no SC on file for patient and Problem
+5 ; original SC was set to "YES"
+6 ;
+7 IF +$GET(GMPORIG(1.1))=1
Begin DoDot:1
+8 WRITE !!,">>> Currently known service-connection data for "_$PIECE(GMPDFN,U,2)_":"
End DoDot:1
+9 IF '$TEST
if 'GMPSC
QUIT
+10 SET DFN=+GMPDFN
DO DIS^SDROUT2
+11 IF +GMPSC=0
IF +$GET(GMPORIG(1.1))=1
Begin DoDot:1
+12 SET DIR("A")="Patient has no service-connected condition !! "
+13 SET DIR("B")="NO"
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 SET DIR("A")="Is this problem related to a service-connected condition? "
+16 if $LENGTH($GET(GMPFLD(1.1)))
SET DIR("B")=$PIECE(GMPFLD(1.1),U,2)
WRITE !
End DoDot:1
+17 SET DIR("?",1)="If this problem is due to a service-connected condition, enter YES;"
SET DIR("?")="press <return> and leave blank if this is unknown."
SET DIR(0)="YAO"
SC1 ; Get Service Connection
+1 DO ^DIR
IF $DATA(DTOUT)!(Y="^")
SET GMPQUIT=1
QUIT
+2 IF Y?1"^".E
DO JUMP^GMPLEDT3(Y)
if $DATA(GMPQUIT)!($GET(GMPLJUMP))
QUIT
if $GET(GMPIFN)
KILL GMPLJUMP
GOTO SC1
+3 IF X="@"
if '$$SURE^GMPLX
GOTO SC1
SET Y=""
+4 SET GMPFLD(1.1)=Y
if Y'=""
SET GMPFLD(1.1)=GMPFLD(1.1)_U_$SELECT(Y:"YES",1:"NO")
+5 QUIT
SP ; Edit Exposures/Conditions
+1 ; Agent Orange - field 1.11
+2 ; Ionizing Radiation - field 1.12
+3 ; Persian Gulf/Environmental Contaminants - field 1.13
+4 ; Head and/or Neck Cancer - field 1.15
+5 ; Military Sexual Trauma - field 1.16
+6 ; Combat Vet - field 1.17
+7 ; SHAD - field 1.18
+8 GOTO SPEXP^GMPLEDT2
+9 QUIT
SOURCE ; Edit Service - field 1.06
+1 ; or Clinic - field 1.08
+2 NEW DIC,DTOUT,X,Y,HELPMSG,PROMPT,DEFAULT,VIEW
SET VIEW=$EXTRACT(GMPLVIEW("VIEW"))
+3 SET DIC=$SELECT(VIEW="S":"^DIC(49,",1:"^SC(")
SET DIC(0)="EMQ"
+4 SET DIC("S")="I $P(^(0),U,"_$SELECT(VIEW="S":9,1:3)_")=""C"""
+5 IF VIEW="S"
SET PROMPT="SERVICE: "
SET DEFAULT=$PIECE(GMPFLD(1.06),U,2)
+6 IF '$TEST
SET PROMPT="CLINIC: "
SET DEFAULT=$PIECE(GMPFLD(1.08),U,2)
+7 SET HELPMSG="Enter the clinic"_$SELECT(VIEW="S":"al service",1:"")_" to be associated with this problem."
S1 ; Get Service/Clinic
+1 WRITE !,PROMPT_$SELECT($LENGTH(DEFAULT):DEFAULT_"//",1:"")
+2 READ X:DTIME
if '$TEST
SET X="^"
SET DTOUT=1
if X="^"
SET GMPQUIT=1
if (X="^")!(X="")
QUIT
+3 IF X?1"^".E
DO JUMP^GMPLEDT3(X)
if $DATA(GMPQUIT)!($GET(GMPLJUMP))
QUIT
if $GET(GMPIFN)
KILL GMPLJUMP
GOTO S1
+4 IF X="?"
WRITE !!,HELPMSG,!
GOTO S1
+5 IF X["??"
DO @("LIST"_$SELECT(VIEW="S":"SERV",1:"CLIN")_"^GMPLMGR1")
WRITE !,HELPMSG
GOTO S1
+6 IF X="@"
if '$$SURE^GMPLX
GOTO S1
SET Y=""
GOTO SQ
+7 DO ^DIC
IF Y'>0
WRITE !?5,"Only clinic"_$SELECT(VIEW="S":"al service",1:"")_"s are allowed!",!
GOTO S1
SQ ; Quit Service/Clinic
+1 if VIEW'="S"
SET GMPFLD(1.08)=Y
if VIEW="S"
SET GMPFLD(1.06)=Y
+2 QUIT
AUTHOR ; Edit Recording Provider - field 1.04
+1 NEW X,Y,PROMPT,HELPMSG,DEFAULT
SET PROMPT="RECORDING PROVIDER: "
+2 SET DEFAULT=$GET(GMPFLD(1.04))
SET HELPMSG="Enter the name of the provider responsible for the recording of this data."
+3 DO NPERSON^GMPLEDT2
if $DATA(GMPQUIT)!($GET(GMPLJUMP))
QUIT
+4 SET GMPFLD(1.04)=$SELECT(+Y>0:Y,1:"")
+5 QUIT
PROV ; Edit Responsible Provider - field 1.05
+1 NEW X,Y,PROMPT,DEFAULT,HELPMSG
SET DEFAULT=$GET(GMPFLD(1.05))
+2 SET PROMPT="PROVIDER: "
SET HELPMSG="Enter the name of the local provider treating this problem."
+3 DO NPERSON^GMPLEDT2
if $DATA(GMPQUIT)!($GET(GMPLJUMP))
QUIT
+4 SET GMPFLD(1.05)=$SELECT(+Y>0:Y,1:"")
+5 QUIT
ICD ; Edit ICD Code - field .01
+1 NEW DIC,DIR,X,Y,DTOUT
ICD0 ; Prompt for ICD Code
+1 KILL DIR
SET DIR(0)="FAO^2:6"
SET DIR("A")="ICD CODE: "
+2 if ($PIECE($GET(GMPFLD(.01)),U,2)="799.9")!($PIECE($GET(GMPFLD(.01)),U,2)="R69.")
SET DIR("A")=IORVON_"ICD CODE: "
+3 if +$GET(GMPFLD(.01))
SET DIR("B")=$PIECE(GMPFLD(.01),U,2)
+4 SET DIR("?")="Enter the ICD code to be associated with this problem"
ICD1 ; Get ICD Code
+1 DO ^DIR
WRITE IORVOFF
IF $DATA(DTOUT)!(Y="^")
SET GMPQUIT=1
QUIT
+2 IF Y?1"^".E
DO JUMP^GMPLEDT3(Y)
if $DATA(GMPQUIT)!($GET(GMPLJUMP))
QUIT
if $GET(GMPIFN)
KILL GMPLJUMP
GOTO ICD1
+3 IF X="@"
WRITE !!,"ICD Code may not be deleted!",!,$CHAR(7)
GOTO ICD1
+4 if X=""
QUIT
if $PIECE($GET(GMPFLD(.01)),U,2)=Y
QUIT
+5 SET DIC=80
SET DIC(0)="EQM"
DO ^DIC
if Y'>0
GOTO ICD0
+6 SET GMPFLD(.01)=Y
+7 QUIT
NOTE ; Attach a note to problem - field 11
+1 NEW X,Y,I,DEFAULT,PROMPT,DONE,NXT,NCNT,GMPLCPTR
SET (I,NCNT,DONE)=0
+2 FOR
Begin DoDot:1
+3 SET NXT=$ORDER(GMPFLD(10,"NEW",I))
if 'NXT
SET NXT=I+1
+4 SET I=NXT
SET NCNT=NCNT+1
+5 SET PROMPT=$SELECT(NCNT=1:"",1:"ANOTHER ")_"COMMENT"_$SELECT(NCNT=1:" (<200 char): ",1:": ")
SET DEFAULT=$GET(GMPFLD(10,"NEW",I))
+6 DO EDNOTE^GMPLEDT4
if $DATA(GMPQUIT)!($GET(GMPLJUMP))
QUIT
+7 IF X="@"
KILL GMPFLD(10,"NEW",I)
QUIT
+8 IF Y=""
SET DONE=1
QUIT
+9 SET GMPFLD(10,"NEW",I)=Y
End DoDot:1
if $DATA(GMPQUIT)!($GET(GMPLJUMP))!DONE
QUIT
+10 QUIT
TERM ; Edit Problem - field 1.01
+1 GOTO TERM^GMPLEDT4
+2 QUIT
Q ; No Editing
+1 QUIT
