- 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 Feb 18, 2025@23:56:28 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