Changeset 623 for WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLEDT2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLEDT2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLEDT2.m
r613 r623 1 GMPLEDT2 ; SLC/MKB/KER -- Problem List edit actions ; 04/15/2002 2 ;;2.0;Problem List;**26,35**;Aug 25, 1994;Build 26 3 ; 4 ; External References 5 ; DBIA 10060 ^VA(200 6 ; DBIA 10003 ^%DT 7 ; DBIA 10006 ^DIC 8 ; DBIA 10026 ^DIR 9 ; DBIA 10103 $$HTFM^XLFDT 10 ; DBIA 10104 $$UP^XLFSTR 11 ; 12 EDITED() ; Returns 1 if problem has been altered 13 N FLD,NOTE,DIFFRENT S DIFFRENT=0 14 F FLD=0:0 S FLD=$O(GMPORIG(FLD)) Q:(FLD'>0)!(FLD'<10) I GMPORIG(FLD)'=GMPFLD(FLD) S DIFFRENT=1 Q 15 G:DIFFRENT EDQ 16 I $D(GMPFLD(10,"NEW"))>9 S DIFFRENT=1 G EDQ 17 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 18 EDQ Q DIFFRENT 19 ; 20 SUREDEL(NUM) ; -- sure you want to delete problems? 21 N DIR,X,Y 22 W !!,"CAUTION: "_$S(NUM=1:"This problem",1:"These "_NUM_" problems")_" will be completely removed",!," from this patient's list!!",! 23 S DIR(0)="YA",DIR("A")="Are you sure? ",DIR("B")="NO" 24 S DIR("?",1)="Enter YES to delete "_$S(NUM=1:"this problem",1:"these problems")_" from the current patient's list." 25 S DIR("?",2)="DO NOT use this option to remove problems from your currently" 26 S DIR("?")="displayed view of the Problem List!!" 27 W $C(7) D ^DIR 28 Q +Y 29 ; 30 DELETE ; Remove current problem from patient's list 31 N CHNGE S VALMBCK=$S(VALMCC:"",1:"R") Q:'$$SUREDEL(1) 32 S CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_"^P^H^Deleted^"_+$G(GMPROV) W "." 33 S $P(^AUPNPROB(GMPIFN,1),U,2)="H",GMPSAVED=1,VALMBCK="Q" W "." 34 D AUDIT^GMPLX(CHNGE,""),DTMOD^GMPLX(GMPIFN) W "." 35 W "... removed!",!!,"Returning to Problem List.",! H 1 36 Q 37 ; 38 VERIFY ; Mark current problem as verified 39 I GMPFLD(1.02)'="T" W $C(7),!!,"This problem does not require verification.",! H 1 Q 40 S GMPFLD(1.02)="P" W !,"." 41 W "... verified!" H 1 42 Q 43 ; 44 NPERSON ; look up into #200, given PROMPT,HELPMSG,DEFAULT (returns X, Y) 45 N DIC 46 NP W !,PROMPT_$S(+DEFAULT:$P(DEFAULT,U,2)_"//",1:"") 47 R X:DTIME S:'$T DTOUT=1 I $D(DTOUT)!(X="^") S GMPQUIT=1 Q 48 I X?1"^".E D JUMP^GMPLEDT3(X) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G NP 49 I X="" S Y=DEFAULT Q 50 I X="@" G:'$$SURE^GMPLX NP S Y="" Q 51 I X="?" W !!,HELPMSG,! G NP 52 I X["??" D NPHELP G NP 53 S DIC="^VA(200,",DIC(0)="EMQ" D ^DIC 54 I Y'>0 W !!,HELPMSG,!,$C(7) G NP 55 Q 56 ; 57 NPHELP ; List names in New Person file 58 N NM,CNT,I,Y S CNT=0,(NM,Y)="" W !,"Choose from: " 59 F S NM=$O(^VA(200,"B",NM)) Q:NM="" D Q:Y'="" 60 . S CNT=CNT+1 I '(CNT#9) D Q:Y="^" 61 . . W " ... more, or ^ to stop: " R Y:DTIME S:'$T Y="^" 62 . S I=$O(^VA(200,"B",NM,0)) W !," "_$P($G(^VA(200,I,0)),U) 63 W ! 64 Q 65 ; 66 DATE ; Edit date fields given PROMPT,HELPMSG,DEFAULT (ret'ns X,Y) 67 N %DT S %DT="EP" 68 D1 W !,PROMPT_$S(+DEFAULT:$P(DEFAULT,U,2)_"//",1:"") 69 R X:DTIME S:'$T DTOUT=1 I $D(DTOUT)!(X="^") S GMPQUIT=1 Q 70 I X?1"^".E D JUMP^GMPLEDT3(X) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G D1 71 I X="" S Y=DEFAULT Q 72 I X="@" G:'$$SURE^GMPLX D1 S Y="" Q 73 I X="?" W !!,HELPMSG,! G D1 74 I X["??" D DTHELP G D1 75 D ^%DT I Y<1 W " INVALID DATE" D DTHELP W !,HELPMSG G D1 76 I Y>DT W !!,"Date cannot be in the future!",!,$C(7) G D1 77 Q 78 ; 79 DTHELP ; Date help 80 W !!,"Examples of valid dates:" 81 W !," Jan 20 1957 or 20 Jan 57 or 1/20/57 or 012057" 82 W !," T (for TODAY), T-1 (for YESTERDAY), T-3W (for 3 WEEKS AGO), etc." 83 W !,"You may omit the precise day, such as Jan 1957, or" 84 W !,"If the year is omitted, a date in the PAST will be assumed.",! 85 Q 86 ; 87 SPEXP ; Edit Fields 1.11, 1.12, 1.13, 1.15, 1.16, 1.17, 1.18 88 D:GMPAGTOR SP(1.11,"Agent Orange") Q:$D(GMPQUIT)!($G(GMPLJUMP)) 89 S:$G(GMPFLD(1.11)) $P(GMPFLD(1.11),U,2)="AGENT ORANGE" 90 D:GMPION SP(1.12,"Radiation") Q:$D(GMPQUIT)!($G(GMPLJUMP)) 91 S:$G(GMPFLD(1.12)) $P(GMPFLD(1.12),U,2)="RADIATION" 92 D:GMPGULF SP(1.13,"Environmental Contaminants") Q:$D(GMPQUIT)!($G(GMPLJUMP)) 93 S:$G(GMPFLD(1.13)) $P(GMPFLD(1.13),U,2)="ENV CONTAMINANTS" 94 D:GMPHNC SP(1.15,"Head and/or Neck Cancer") Q:$D(GMPQUIT)!($G(GMPLJUMP)) 95 S:$G(GMPFLD(1.15)) $P(GMPFLD(1.15),U,2)="HEAD/NECK CANCER" 96 D:GMPMST SP(1.16,"Military Sexual Trauma") Q:$D(GMPQUIT)!($G(GMPLJUMP)) 97 S:$G(GMPFLD(1.16)) $P(GMPFLD(1.16),U,2)="MIL SEXUAL TRAUMA" 98 D:GMPCV SP(1.17,"Combat Veteran") Q:$D(GMPQUIT)!($G(GMPLJUMP)) 99 S:$G(GMPFLD(1.17)) $P(GMPFLD(1.17),U,2)="COMBAT VET" 100 D:GMPSHD SP(1.18,"Shipboard Hazard and Defense") Q:$D(GMPQUIT)!($G(GMPLJUMP)) 101 S:$G(GMPFLD(1.18)) $P(GMPFLD(1.18),U,2)="SHAD" 102 Q 103 SP(FLD,NAME) ; edit exposure fields -- Requires FLD number & field NAME 104 N DIR,X,Y,GMPLN S DIR(0)="YAO",GMPLN=$$UP^XLFSTR(NAME) 105 S DIR("A")="Is this problem related to "_GMPLN 106 S:GMPLN'["SEXUAL"&(GMPLN'["CANCER") DIR("A")=DIR("A")_" EXPOSURE" S DIR("A")=DIR("A")_"? " 107 S DIR("?",1)="Enter YES if this problem is related in some way to the patient's" 108 S DIR("?")="diagnosed "_NAME_"." S:GMPLN["SEXUAL" DIR("?")="reported "_NAME_"." S:GMPLN'["SEXUAL"&(GMPLN'["CANCER") DIR("?")="exposure to "_NAME_"." 109 S:$L($G(GMPFLD(FLD))) DIR("B")=$S(+GMPFLD(FLD):"YES",1:"NO") 110 SP1 D ^DIR I $D(DTOUT)!(Y="^") S GMPQUIT=1 Q 111 I Y?1"^".E D JUMP^GMPLEDT3(Y) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G SP1 112 I X="@" G:'$$SURE^GMPLX SP1 S Y="" 113 S GMPFLD(FLD)=Y S:Y'="" GMPFLD(FLD)=GMPFLD(FLD)_U_$S(Y:"YES",1:"NO") 114 Q 1 GMPLEDT2 ; SLC/MKB/KER -- Problem List edit actions ; 04/15/2002 2 ;;2.0;Problem List;**26**;Aug 25, 1994 3 ; 4 ; External References 5 ; DBIA 10060 ^VA(200 6 ; DBIA 10003 ^%DT 7 ; DBIA 10006 ^DIC 8 ; DBIA 10026 ^DIR 9 ; DBIA 10103 $$HTFM^XLFDT 10 ; DBIA 10104 $$UP^XLFSTR 11 ; 12 EDITED() ; Returns 1 if problem has been altered 13 N FLD,NOTE,DIFFRENT S DIFFRENT=0 14 F FLD=0:0 S FLD=$O(GMPORIG(FLD)) Q:(FLD'>0)!(FLD'<10) I GMPORIG(FLD)'=GMPFLD(FLD) S DIFFRENT=1 Q 15 G:DIFFRENT EDQ 16 I $D(GMPFLD(10,"NEW"))>9 S DIFFRENT=1 G EDQ 17 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 18 EDQ Q DIFFRENT 19 ; 20 SUREDEL(NUM) ; -- sure you want to delete problems? 21 N DIR,X,Y 22 W !!,"CAUTION: "_$S(NUM=1:"This problem",1:"These "_NUM_" problems")_" will be completely removed",!," from this patient's list!!",! 23 S DIR(0)="YA",DIR("A")="Are you sure? ",DIR("B")="NO" 24 S DIR("?",1)="Enter YES to delete "_$S(NUM=1:"this problem",1:"these problems")_" from the current patient's list." 25 S DIR("?",2)="DO NOT use this option to remove problems from your currently" 26 S DIR("?")="displayed view of the Problem List!!" 27 W $C(7) D ^DIR 28 Q +Y 29 ; 30 DELETE ; Remove current problem from patient's list 31 N CHNGE S VALMBCK=$S(VALMCC:"",1:"R") Q:'$$SUREDEL(1) 32 S CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_"^P^H^Deleted^"_+$G(GMPROV) W "." 33 S $P(^AUPNPROB(GMPIFN,1),U,2)="H",GMPSAVED=1,VALMBCK="Q" W "." 34 D AUDIT^GMPLX(CHNGE,""),DTMOD^GMPLX(GMPIFN) W "." 35 W "... removed!",!!,"Returning to Problem List.",! H 1 36 Q 37 ; 38 VERIFY ; Mark current problem as verified 39 I GMPFLD(1.02)'="T" W $C(7),!!,"This problem does not require verification.",! H 1 Q 40 S GMPFLD(1.02)="P" W !,"." 41 W "... verified!" H 1 42 Q 43 ; 44 NPERSON ; look up into #200, given PROMPT,HELPMSG,DEFAULT (returns X, Y) 45 N DIC 46 NP W !,PROMPT_$S(+DEFAULT:$P(DEFAULT,U,2)_"//",1:"") 47 R X:DTIME S:'$T DTOUT=1 I $D(DTOUT)!(X="^") S GMPQUIT=1 Q 48 I X?1"^".E D JUMP^GMPLEDT3(X) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G NP 49 I X="" S Y=DEFAULT Q 50 I X="@" G:'$$SURE^GMPLX NP S Y="" Q 51 I X="?" W !!,HELPMSG,! G NP 52 I X["??" D NPHELP G NP 53 S DIC="^VA(200,",DIC(0)="EMQ" D ^DIC 54 I Y'>0 W !!,HELPMSG,!,$C(7) G NP 55 Q 56 ; 57 NPHELP ; List names in New Person file 58 N NM,CNT,I,Y S CNT=0,(NM,Y)="" W !,"Choose from: " 59 F S NM=$O(^VA(200,"B",NM)) Q:NM="" D Q:Y'="" 60 . S CNT=CNT+1 I '(CNT#9) D Q:Y="^" 61 . . W " ... more, or ^ to stop: " R Y:DTIME S:'$T Y="^" 62 . S I=$O(^VA(200,"B",NM,0)) W !," "_$P($G(^VA(200,I,0)),U) 63 W ! 64 Q 65 ; 66 DATE ; Edit date fields given PROMPT,HELPMSG,DEFAULT (ret'ns X,Y) 67 N %DT S %DT="EP" 68 D1 W !,PROMPT_$S(+DEFAULT:$P(DEFAULT,U,2)_"//",1:"") 69 R X:DTIME S:'$T DTOUT=1 I $D(DTOUT)!(X="^") S GMPQUIT=1 Q 70 I X?1"^".E D JUMP^GMPLEDT3(X) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G D1 71 I X="" S Y=DEFAULT Q 72 I X="@" G:'$$SURE^GMPLX D1 S Y="" Q 73 I X="?" W !!,HELPMSG,! G D1 74 I X["??" D DTHELP G D1 75 D ^%DT I Y<1 W " INVALID DATE" D DTHELP W !,HELPMSG G D1 76 I Y>DT W !!,"Date cannot be in the future!",!,$C(7) G D1 77 Q 78 ; 79 DTHELP ; Date help 80 W !!,"Examples of valid dates:" 81 W !," Jan 20 1957 or 20 Jan 57 or 1/20/57 or 012057" 82 W !," T (for TODAY), T-1 (for YESTERDAY), T-3W (for 3 WEEKS AGO), etc." 83 W !,"You may omit the precise day, such as Jan 1957, or" 84 W !,"If the year is omitted, a date in the PAST will be assumed.",! 85 Q 86 ; 87 SPEXP ; Edit Fields 1.11, 1.12, 1.13, 1.15, 1.16 88 D:GMPAGTOR SP(1.11,"Agent Orange") Q:$D(GMPQUIT)!($G(GMPLJUMP)) 89 S:$G(GMPFLD(1.11)) $P(GMPFLD(1.11),U,2)="AGENT ORANGE" 90 D:GMPION SP(1.12,"Radiation") Q:$D(GMPQUIT)!($G(GMPLJUMP)) 91 S:$G(GMPFLD(1.12)) $P(GMPFLD(1.12),U,2)="RADIATION" 92 D:GMPGULF SP(1.13,"Environmental Contaminants") Q:$D(GMPQUIT)!($G(GMPLJUMP)) 93 S:$G(GMPFLD(1.13)) $P(GMPFLD(1.13),U,2)="ENV CONTAMINANTS" 94 D:GMPHNC SP(1.15,"Head and/or Neck Cancer") Q:$D(GMPQUIT)!($G(GMPLJUMP)) 95 S:$G(GMPFLD(1.15)) $P(GMPFLD(1.15),U,2)="HEAD/NECK CANCER" 96 D:GMPMST SP(1.16,"Military Sexual Trauma") Q:$D(GMPQUIT)!($G(GMPLJUMP)) 97 S:$G(GMPFLD(1.16)) $P(GMPFLD(1.16),U,2)="MIL SEXUAL TRAUMA" 98 Q 99 SP(FLD,NAME) ; edit exposure fields -- Requires FLD number & field NAME 100 N DIR,X,Y,GMPLN S DIR(0)="YAO",GMPLN=$$UP^XLFSTR(NAME) 101 S DIR("A")="Is this problem related to "_GMPLN 102 S:GMPLN'["SEXUAL"&(GMPLN'["CANCER") DIR("A")=DIR("A")_" EXPOSURE" S DIR("A")=DIR("A")_"? " 103 S DIR("?",1)="Enter YES if this problem is related in some way to the patient's" 104 S DIR("?")="diagnosed "_NAME_"." S:GMPLN["SEXUAL" DIR("?")="reported "_NAME_"." S:GMPLN'["SEXUAL"&(GMPLN'["CANCER") DIR("?")="exposure to "_NAME_"." 105 S:$L($G(GMPFLD(FLD))) DIR("B")=$S(+GMPFLD(FLD):"YES",1:"NO") 106 SP1 D ^DIR I $D(DTOUT)!(Y="^") S GMPQUIT=1 Q 107 I Y?1"^".E D JUMP^GMPLEDT3(Y) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G SP1 108 I X="@" G:'$$SURE^GMPLX SP1 S Y="" 109 S GMPFLD(FLD)=Y S:Y'="" GMPFLD(FLD)=GMPFLD(FLD)_U_$S(Y:"YES",1:"NO") 110 Q
Note:
See TracChangeset
for help on using the changeset viewer.
