- GMPLEDT2 ; SLC/MKB/KER -- Problem List edit actions ; 04/15/2002
- ;;2.0;Problem List;**26,35**;Aug 25, 1994;Build 26
- ;
- ; External References
- ; DBIA 10060 ^VA(200
- ; DBIA 10003 ^%DT
- ; DBIA 10006 ^DIC
- ; DBIA 10026 ^DIR
- ; DBIA 10103 $$HTFM^XLFDT
- ; DBIA 10104 $$UP^XLFSTR
- ;
- EDITED() ; Returns 1 if problem has been altered
- N FLD,NOTE,DIFFRENT S DIFFRENT=0
- F FLD=0:0 S FLD=$O(GMPORIG(FLD)) Q:(FLD'>0)!(FLD'<10) I GMPORIG(FLD)'=GMPFLD(FLD) S DIFFRENT=1 Q
- G:DIFFRENT EDQ
- I $D(GMPFLD(10,"NEW"))>9 S DIFFRENT=1 G EDQ
- F NOTE=0:0 S NOTE=$O(GMPORIG(10,NOTE)) Q:NOTE'>0 I $P(GMPORIG(10,NOTE),U,3)'=$P(GMPFLD(10,NOTE),U,3) S DIFFRENT=1 Q
- EDQ Q DIFFRENT
- ;
- SUREDEL(NUM) ; -- sure you want to delete problems?
- N DIR,X,Y
- W !!,"CAUTION: "_$S(NUM=1:"This problem",1:"These "_NUM_" problems")_" will be completely removed",!," from this patient's list!!",!
- S DIR(0)="YA",DIR("A")="Are you sure? ",DIR("B")="NO"
- S DIR("?",1)="Enter YES to delete "_$S(NUM=1:"this problem",1:"these problems")_" from the current patient's list."
- S DIR("?",2)="DO NOT use this option to remove problems from your currently"
- S DIR("?")="displayed view of the Problem List!!"
- W $C(7) D ^DIR
- Q +Y
- ;
- DELETE ; Remove current problem from patient's list
- N CHNGE S VALMBCK=$S(VALMCC:"",1:"R") Q:'$$SUREDEL(1)
- S CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_"^P^H^Deleted^"_+$G(GMPROV) W "."
- S $P(^AUPNPROB(GMPIFN,1),U,2)="H",GMPSAVED=1,VALMBCK="Q" W "."
- D AUDIT^GMPLX(CHNGE,""),DTMOD^GMPLX(GMPIFN) W "."
- W "... removed!",!!,"Returning to Problem List.",! H 1
- Q
- ;
- VERIFY ; Mark current problem as verified
- I GMPFLD(1.02)'="T" W $C(7),!!,"This problem does not require verification.",! H 1 Q
- S GMPFLD(1.02)="P" W !,"."
- W "... verified!" H 1
- Q
- ;
- NPERSON ; look up into #200, given PROMPT,HELPMSG,DEFAULT (returns X, Y)
- N DIC
- NP W !,PROMPT_$S(+DEFAULT:$P(DEFAULT,U,2)_"//",1:"")
- R X:DTIME S:'$T DTOUT=1 I $D(DTOUT)!(X="^") S GMPQUIT=1 Q
- I X?1"^".E D JUMP^GMPLEDT3(X) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G NP
- I X="" S Y=DEFAULT Q
- I X="@" G:'$$SURE^GMPLX NP S Y="" Q
- I X="?" W !!,HELPMSG,! G NP
- I X["??" D NPHELP G NP
- S DIC="^VA(200,",DIC(0)="EMQ" D ^DIC
- I Y'>0 W !!,HELPMSG,!,$C(7) G NP
- Q
- ;
- NPHELP ; List names in New Person file
- N NM,CNT,I,Y S CNT=0,(NM,Y)="" W !,"Choose from: "
- F S NM=$O(^VA(200,"B",NM)) Q:NM="" D Q:Y'=""
- . S CNT=CNT+1 I '(CNT#9) D Q:Y="^"
- . . W " ... more, or ^ to stop: " R Y:DTIME S:'$T Y="^"
- . S I=$O(^VA(200,"B",NM,0)) W !," "_$P($G(^VA(200,I,0)),U)
- W !
- Q
- ;
- DATE ; Edit date fields given PROMPT,HELPMSG,DEFAULT (ret'ns X,Y)
- N %DT S %DT="EP"
- D1 W !,PROMPT_$S(+DEFAULT:$P(DEFAULT,U,2)_"//",1:"")
- R X:DTIME S:'$T DTOUT=1 I $D(DTOUT)!(X="^") S GMPQUIT=1 Q
- I X?1"^".E D JUMP^GMPLEDT3(X) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G D1
- I X="" S Y=DEFAULT Q
- I X="@" G:'$$SURE^GMPLX D1 S Y="" Q
- I X="?" W !!,HELPMSG,! G D1
- I X["??" D DTHELP G D1
- D ^%DT I Y<1 W " INVALID DATE" D DTHELP W !,HELPMSG G D1
- I Y>DT W !!,"Date cannot be in the future!",!,$C(7) G D1
- Q
- ;
- DTHELP ; Date help
- W !!,"Examples of valid dates:"
- W !," Jan 20 1957 or 20 Jan 57 or 1/20/57 or 012057"
- W !," T (for TODAY), T-1 (for YESTERDAY), T-3W (for 3 WEEKS AGO), etc."
- W !,"You may omit the precise day, such as Jan 1957, or"
- W !,"If the year is omitted, a date in the PAST will be assumed.",!
- Q
- ;
- SPEXP ; Edit Fields 1.11, 1.12, 1.13, 1.15, 1.16, 1.17, 1.18
- D:GMPAGTOR SP(1.11,"Agent Orange") Q:$D(GMPQUIT)!($G(GMPLJUMP))
- S:$G(GMPFLD(1.11)) $P(GMPFLD(1.11),U,2)="AGENT ORANGE"
- D:GMPION SP(1.12,"Radiation") Q:$D(GMPQUIT)!($G(GMPLJUMP))
- S:$G(GMPFLD(1.12)) $P(GMPFLD(1.12),U,2)="RADIATION"
- D:GMPGULF SP(1.13,"Environmental Contaminants") Q:$D(GMPQUIT)!($G(GMPLJUMP))
- S:$G(GMPFLD(1.13)) $P(GMPFLD(1.13),U,2)="ENV CONTAMINANTS"
- D:GMPHNC SP(1.15,"Head and/or Neck Cancer") Q:$D(GMPQUIT)!($G(GMPLJUMP))
- S:$G(GMPFLD(1.15)) $P(GMPFLD(1.15),U,2)="HEAD/NECK CANCER"
- D:GMPMST SP(1.16,"Military Sexual Trauma") Q:$D(GMPQUIT)!($G(GMPLJUMP))
- S:$G(GMPFLD(1.16)) $P(GMPFLD(1.16),U,2)="MIL SEXUAL TRAUMA"
- D:GMPCV SP(1.17,"Combat Veteran") Q:$D(GMPQUIT)!($G(GMPLJUMP))
- S:$G(GMPFLD(1.17)) $P(GMPFLD(1.17),U,2)="COMBAT VET"
- D:GMPSHD SP(1.18,"Shipboard Hazard and Defense") Q:$D(GMPQUIT)!($G(GMPLJUMP))
- S:$G(GMPFLD(1.18)) $P(GMPFLD(1.18),U,2)="SHAD"
- Q
- SP(FLD,NAME) ; edit exposure fields -- Requires FLD number & field NAME
- N DIR,X,Y,GMPLN S DIR(0)="YAO",GMPLN=$$UP^XLFSTR(NAME)
- S DIR("A")="Is this problem related to "_GMPLN
- S:GMPLN'["SEXUAL"&(GMPLN'["CANCER") DIR("A")=DIR("A")_" EXPOSURE" S DIR("A")=DIR("A")_"? "
- S DIR("?",1)="Enter YES if this problem is related in some way to the patient's"
- S DIR("?")="diagnosed "_NAME_"." S:GMPLN["SEXUAL" DIR("?")="reported "_NAME_"." S:GMPLN'["SEXUAL"&(GMPLN'["CANCER") DIR("?")="exposure to "_NAME_"."
- S:$L($G(GMPFLD(FLD))) DIR("B")=$S(+GMPFLD(FLD):"YES",1:"NO")
- SP1 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 SP1
- I X="@" G:'$$SURE^GMPLX SP1 S Y=""
- S GMPFLD(FLD)=Y S:Y'="" GMPFLD(FLD)=GMPFLD(FLD)_U_$S(Y:"YES",1:"NO")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLEDT2 5267 printed Jan 18, 2025@03:31:10 Page 2
- GMPLEDT2 ; SLC/MKB/KER -- Problem List edit actions ; 04/15/2002
- +1 ;;2.0;Problem List;**26,35**;Aug 25, 1994;Build 26
- +2 ;
- +3 ; External References
- +4 ; DBIA 10060 ^VA(200
- +5 ; DBIA 10003 ^%DT
- +6 ; DBIA 10006 ^DIC
- +7 ; DBIA 10026 ^DIR
- +8 ; DBIA 10103 $$HTFM^XLFDT
- +9 ; DBIA 10104 $$UP^XLFSTR
- +10 ;
- EDITED() ; Returns 1 if problem has been altered
- +1 NEW FLD,NOTE,DIFFRENT
- SET DIFFRENT=0
- +2 FOR FLD=0:0
- SET FLD=$ORDER(GMPORIG(FLD))
- if (FLD'>0)!(FLD'<10)
- QUIT
- IF GMPORIG(FLD)'=GMPFLD(FLD)
- SET DIFFRENT=1
- QUIT
- +3 if DIFFRENT
- GOTO EDQ
- +4 IF $DATA(GMPFLD(10,"NEW"))>9
- SET DIFFRENT=1
- GOTO EDQ
- +5 FOR NOTE=0:0
- SET NOTE=$ORDER(GMPORIG(10,NOTE))
- if NOTE'>0
- QUIT
- IF $PIECE(GMPORIG(10,NOTE),U,3)'=$PIECE(GMPFLD(10,NOTE),U,3)
- SET DIFFRENT=1
- QUIT
- EDQ QUIT DIFFRENT
- +1 ;
- SUREDEL(NUM) ; -- sure you want to delete problems?
- +1 NEW DIR,X,Y
- +2 WRITE !!,"CAUTION: "_$SELECT(NUM=1:"This problem",1:"These "_NUM_" problems")_" will be completely removed",!," from this patient's list!!",!
- +3 SET DIR(0)="YA"
- SET DIR("A")="Are you sure? "
- SET DIR("B")="NO"
- +4 SET DIR("?",1)="Enter YES to delete "_$SELECT(NUM=1:"this problem",1:"these problems")_" from the current patient's list."
- +5 SET DIR("?",2)="DO NOT use this option to remove problems from your currently"
- +6 SET DIR("?")="displayed view of the Problem List!!"
- +7 WRITE $CHAR(7)
- DO ^DIR
- +8 QUIT +Y
- +9 ;
- DELETE ; Remove current problem from patient's list
- +1 NEW CHNGE
- SET VALMBCK=$SELECT(VALMCC:"",1:"R")
- if '$$SUREDEL(1)
- QUIT
- +2 SET CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($HOROLOG)_U_DUZ_"^P^H^Deleted^"_+$GET(GMPROV)
- WRITE "."
- +3 SET $PIECE(^AUPNPROB(GMPIFN,1),U,2)="H"
- SET GMPSAVED=1
- SET VALMBCK="Q"
- WRITE "."
- +4 DO AUDIT^GMPLX(CHNGE,"")
- DO DTMOD^GMPLX(GMPIFN)
- WRITE "."
- +5 WRITE "... removed!",!!,"Returning to Problem List.",!
- HANG 1
- +6 QUIT
- +7 ;
- VERIFY ; Mark current problem as verified
- +1 IF GMPFLD(1.02)'="T"
- WRITE $CHAR(7),!!,"This problem does not require verification.",!
- HANG 1
- QUIT
- +2 SET GMPFLD(1.02)="P"
- WRITE !,"."
- +3 WRITE "... verified!"
- HANG 1
- +4 QUIT
- +5 ;
- NPERSON ; look up into #200, given PROMPT,HELPMSG,DEFAULT (returns X, Y)
- +1 NEW DIC
- NP WRITE !,PROMPT_$SELECT(+DEFAULT:$PIECE(DEFAULT,U,2)_"//",1:"")
- +1 READ X:DTIME
- if '$TEST
- SET DTOUT=1
- IF $DATA(DTOUT)!(X="^")
- SET GMPQUIT=1
- QUIT
- +2 IF X?1"^".E
- DO JUMP^GMPLEDT3(X)
- if $DATA(GMPQUIT)!($GET(GMPLJUMP))
- QUIT
- if $GET(GMPIFN)
- KILL GMPLJUMP
- GOTO NP
- +3 IF X=""
- SET Y=DEFAULT
- QUIT
- +4 IF X="@"
- if '$$SURE^GMPLX
- GOTO NP
- SET Y=""
- QUIT
- +5 IF X="?"
- WRITE !!,HELPMSG,!
- GOTO NP
- +6 IF X["??"
- DO NPHELP
- GOTO NP
- +7 SET DIC="^VA(200,"
- SET DIC(0)="EMQ"
- DO ^DIC
- +8 IF Y'>0
- WRITE !!,HELPMSG,!,$CHAR(7)
- GOTO NP
- +9 QUIT
- +10 ;
- NPHELP ; List names in New Person file
- +1 NEW NM,CNT,I,Y
- SET CNT=0
- SET (NM,Y)=""
- WRITE !,"Choose from: "
- +2 FOR
- SET NM=$ORDER(^VA(200,"B",NM))
- if NM=""
- QUIT
- Begin DoDot:1
- +3 SET CNT=CNT+1
- IF '(CNT#9)
- Begin DoDot:2
- +4 WRITE " ... more, or ^ to stop: "
- READ Y:DTIME
- if '$TEST
- SET Y="^"
- End DoDot:2
- if Y="^"
- QUIT
- +5 SET I=$ORDER(^VA(200,"B",NM,0))
- WRITE !," "_$PIECE($GET(^VA(200,I,0)),U)
- End DoDot:1
- if Y'=""
- QUIT
- +6 WRITE !
- +7 QUIT
- +8 ;
- DATE ; Edit date fields given PROMPT,HELPMSG,DEFAULT (ret'ns X,Y)
- +1 NEW %DT
- SET %DT="EP"
- D1 WRITE !,PROMPT_$SELECT(+DEFAULT:$PIECE(DEFAULT,U,2)_"//",1:"")
- +1 READ X:DTIME
- if '$TEST
- SET DTOUT=1
- IF $DATA(DTOUT)!(X="^")
- SET GMPQUIT=1
- QUIT
- +2 IF X?1"^".E
- DO JUMP^GMPLEDT3(X)
- if $DATA(GMPQUIT)!($GET(GMPLJUMP))
- QUIT
- if $GET(GMPIFN)
- KILL GMPLJUMP
- GOTO D1
- +3 IF X=""
- SET Y=DEFAULT
- QUIT
- +4 IF X="@"
- if '$$SURE^GMPLX
- GOTO D1
- SET Y=""
- QUIT
- +5 IF X="?"
- WRITE !!,HELPMSG,!
- GOTO D1
- +6 IF X["??"
- DO DTHELP
- GOTO D1
- +7 DO ^%DT
- IF Y<1
- WRITE " INVALID DATE"
- DO DTHELP
- WRITE !,HELPMSG
- GOTO D1
- +8 IF Y>DT
- WRITE !!,"Date cannot be in the future!",!,$CHAR(7)
- GOTO D1
- +9 QUIT
- +10 ;
- DTHELP ; Date help
- +1 WRITE !!,"Examples of valid dates:"
- +2 WRITE !," Jan 20 1957 or 20 Jan 57 or 1/20/57 or 012057"
- +3 WRITE !," T (for TODAY), T-1 (for YESTERDAY), T-3W (for 3 WEEKS AGO), etc."
- +4 WRITE !,"You may omit the precise day, such as Jan 1957, or"
- +5 WRITE !,"If the year is omitted, a date in the PAST will be assumed.",!
- +6 QUIT
- +7 ;
- SPEXP ; Edit Fields 1.11, 1.12, 1.13, 1.15, 1.16, 1.17, 1.18
- +1 if GMPAGTOR
- DO SP(1.11,"Agent Orange")
- if $DATA(GMPQUIT)!($GET(GMPLJUMP))
- QUIT
- +2 if $GET(GMPFLD(1.11))
- SET $PIECE(GMPFLD(1.11),U,2)="AGENT ORANGE"
- +3 if GMPION
- DO SP(1.12,"Radiation")
- if $DATA(GMPQUIT)!($GET(GMPLJUMP))
- QUIT
- +4 if $GET(GMPFLD(1.12))
- SET $PIECE(GMPFLD(1.12),U,2)="RADIATION"
- +5 if GMPGULF
- DO SP(1.13,"Environmental Contaminants")
- if $DATA(GMPQUIT)!($GET(GMPLJUMP))
- QUIT
- +6 if $GET(GMPFLD(1.13))
- SET $PIECE(GMPFLD(1.13),U,2)="ENV CONTAMINANTS"
- +7 if GMPHNC
- DO SP(1.15,"Head and/or Neck Cancer")
- if $DATA(GMPQUIT)!($GET(GMPLJUMP))
- QUIT
- +8 if $GET(GMPFLD(1.15))
- SET $PIECE(GMPFLD(1.15),U,2)="HEAD/NECK CANCER"
- +9 if GMPMST
- DO SP(1.16,"Military Sexual Trauma")
- if $DATA(GMPQUIT)!($GET(GMPLJUMP))
- QUIT
- +10 if $GET(GMPFLD(1.16))
- SET $PIECE(GMPFLD(1.16),U,2)="MIL SEXUAL TRAUMA"
- +11 if GMPCV
- DO SP(1.17,"Combat Veteran")
- if $DATA(GMPQUIT)!($GET(GMPLJUMP))
- QUIT
- +12 if $GET(GMPFLD(1.17))
- SET $PIECE(GMPFLD(1.17),U,2)="COMBAT VET"
- +13 if GMPSHD
- DO SP(1.18,"Shipboard Hazard and Defense")
- if $DATA(GMPQUIT)!($GET(GMPLJUMP))
- QUIT
- +14 if $GET(GMPFLD(1.18))
- SET $PIECE(GMPFLD(1.18),U,2)="SHAD"
- +15 QUIT
- SP(FLD,NAME) ; edit exposure fields -- Requires FLD number & field NAME
- +1 NEW DIR,X,Y,GMPLN
- SET DIR(0)="YAO"
- SET GMPLN=$$UP^XLFSTR(NAME)
- +2 SET DIR("A")="Is this problem related to "_GMPLN
- +3 if GMPLN'["SEXUAL"&(GMPLN'["CANCER")
- SET DIR("A")=DIR("A")_" EXPOSURE"
- SET DIR("A")=DIR("A")_"? "
- +4 SET DIR("?",1)="Enter YES if this problem is related in some way to the patient's"
- +5 SET DIR("?")="diagnosed "_NAME_"."
- if GMPLN["SEXUAL"
- SET DIR("?")="reported "_NAME_"."
- if GMPLN'["SEXUAL"&(GMPLN'["CANCER")
- SET DIR("?")="exposure to "_NAME_"."
- +6 if $LENGTH($GET(GMPFLD(FLD)))
- SET DIR("B")=$SELECT(+GMPFLD(FLD):"YES",1:"NO")
- SP1 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 SP1
- +2 IF X="@"
- if '$$SURE^GMPLX
- GOTO SP1
- SET Y=""
- +3 SET GMPFLD(FLD)=Y
- if Y'=""
- SET GMPFLD(FLD)=GMPFLD(FLD)_U_$SELECT(Y:"YES",1:"NO")
- +4 QUIT