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 Apr 09, 2024@21:33:15 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
