Changeset 623 for WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- Location:
- WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL
- Files:
-
- 13 edited
-
GMPLDISP.m (modified) (1 diff)
-
GMPLEDIT.m (modified) (1 diff)
-
GMPLEDT1.m (modified) (1 diff)
-
GMPLEDT2.m (modified) (1 diff)
-
GMPLEDT3.m (modified) (1 diff)
-
GMPLENFM.m (modified) (1 diff)
-
GMPLHIST.m (modified) (1 diff)
-
GMPLHS.m (modified) (1 diff)
-
GMPLSAVE.m (modified) (1 diff)
-
GMPLUTL.m (modified) (1 diff)
-
GMPLUTL1.m (modified) (1 diff)
-
GMPLUTL2.m (modified) (1 diff)
-
GMPLX1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLDISP.m
r613 r623 1 GMPLDISP 2 ;;2.0;Problem List;**21,26,35**;Aug 25, 1994;Build 26 3 4 5 6 7 8 9 10 11 12 13 14 15 16 EN 17 18 19 20 21 22 23 24 PROB 25 26 27 28 F I=11,12,13,15,16,17,18 S:+$P(GMPL1,U,I) SP=SP_$S(I=11:"AGENT ORANGE",I=12:"RADIATION",I=13:"ENV CONTAMINANTS",I=15:"HEAD/NECK CANCER",I=16:"MIL SEXUAL TRAUMA",I=17:"COMBAT VET",1:"SHAD")_U29 30 31 32 33 34 PR1 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 PR2 58 59 60 61 62 63 64 65 66 67 68 69 70 PR3 71 72 73 74 75 76 77 78 79 80 81 82 PR4 83 84 85 86 87 88 89 PRQ 90 91 92 93 HDR 94 95 96 97 98 99 100 HELP 101 102 103 104 105 106 107 108 109 110 DEFLT() 111 112 113 114 ERROR 115 116 117 EXIT 118 1 GMPLDISP ; SLC/MKB -- Problem List detailed display ; 04/15/2002 2 ;;2.0;Problem List;**21,26**;Aug 25, 1994 3 ; 4 ; External References 5 ; DBIA 3106 ^DIC(49 6 ; DBIA 10082 ^ICD9( file 80 7 ; DBIA 10040 ^SC( file 44 8 ; DBIA 10060 ^VA(200 9 ; DBIA 10116 $$SETSTR^VALM1 10 ; DBIA 10117 CLEAN^VALM10 11 ; DBIA 10117 CNTRL^VALM10 12 ; DBIA 10103 $$FMTE^XLFDT 13 ; DBIA 10103 $$HTFM^XLFDT 14 ; DBIA 10104 $$REPEAT^XLFSTR 15 ; 16 EN ; Init Variables (need GMPLSEL,GMPLNO) and List Array 17 G:'$D(GMPLSEL) ERROR G:'$G(GMPLNO) ERROR 18 S GMPI=+$G(GMPI)+1 I GMPI>GMPLNO D Q 19 . W !!,"There are no more problems that have been selected to view!",! S VALMBCK="" H 2 20 S GMPLNUM=$P(GMPLSEL,",",GMPI) G:GMPLNUM'>0 ERROR 21 S GMPIFN=$P($G(^TMP("GMPLIDX",$J,+GMPLNUM)),U,2) G:GMPIFN'>0 ERROR 22 W !!,"Retrieving current data for problem #"_GMPLNUM_" ...",! 23 ; 24 PROB ; Display problem GMPIFN 25 N LINE,STR,I,TEXT,NOTE,GMPL0,GMPL1,X,Y,IDT,FAC,AIFN,SP,LCNT,NIFN 26 G:'$G(GMPIFN) ERROR D CLEAN^VALM10 27 S GMPL0=$G(^AUPNPROB(GMPIFN,0)),GMPL1=$G(^(1)),LCNT=1,SP="" 28 F I=11,12,13,15,16 S:+$P(GMPL1,U,I) SP=SP_$S(I=11:"AGENT ORANGE",I=12:"RADIATION",I=13:"ENV CONTAMINANTS",I=15:"HEAD/NECK CANCER",1:"MIL SEXUAL TRAUMA")_U 29 F Q:$E(SP,$L(SP))'="^" S SP=$E(SP,1,($L(SP)-1)) 30 D WRAP^GMPLX($$PROBTEXT^GMPLX(GMPIFN),65,.TEXT) 31 S GMPDT(LCNT,0)=" Problem: "_TEXT(1) 32 I TEXT>1 F I=2:1:TEXT S LCNT=LCNT+1,GMPDT(LCNT,0)=TEXT(I) 33 S LCNT=LCNT+1,GMPDT(LCNT,0)=" " 34 PR1 ; Onset 35 ; SC Condition 36 ; Status 37 ; Exposure 38 ; Provider 39 ; Service/Clinic 40 S LINE=" Onset: "_$S($P(GMPL0,U,13):$$EXTDT^GMPLX($P(GMPL0,U,13)),1:"date unknown"),STR="" 41 S:GMPVA STR="SC Condition: "_$S(+$P(GMPL1,U,10):"YES",$P(GMPL1,U,10)=0:"NO",1:"unknown") 42 S LINE=$$SETSTR^VALM1(STR,LINE,49,30),LCNT=LCNT+1,GMPDT(LCNT,0)=LINE 43 S X=$P(GMPL0,U,12),LINE=" Status: "_$S(X="A":"ACTIVE",1:"INACTIVE") 44 I X="A",$L($P(GMPL1,U,14)) S LINE=LINE_"/"_$S($P(GMPL1,U,14)="A":"ACUTE",1:"CHRONIC") 45 I X="I",$P(GMPL1,U,7) S LINE=LINE_", Resolved "_$$EXTDT^GMPLX($P(GMPL1,U,7)) 46 S STR="",LCNT=LCNT+1 47 S:GMPVA STR=" Exposure: "_$S('$L(SP):"none",1:$P(SP,U)) 48 S LINE=$$SETSTR^VALM1(STR,LINE,49,30),GMPDT(LCNT,0)=LINE 49 S LINE=" Provider: "_$P($G(^VA(200,+$P(GMPL1,U,5),0)),U),LCNT=LCNT+1,STR="" 50 I GMPVA,$L(SP,U)>1 S STR=$P(SP,U,2) 51 S LINE=$$SETSTR^VALM1(STR,LINE,63,16),GMPDT(LCNT,0)=LINE 52 I $E(GMPLVIEW("VIEW"))="S" S LINE=" Service: "_$P($G(^DIC(49,+$P(GMPL1,U,6),0)),U) 53 E S LINE=" Clinic: "_$P($G(^SC(+$P(GMPL1,U,8),0)),U) 54 S LCNT=LCNT+1,STR="" I GMPVA,$L(SP,U)>2 S STR=$P(SP,U,3) 55 S LINE=$$SETSTR^VALM1(STR,LINE,63,16),GMPDT(LCNT,0)=LINE 56 S LCNT=LCNT+1,GMPDT(LCNT,0)=" " 57 PR2 ; Recorded 58 ; Entered 59 ; Provider Narrative 60 ; ICD code 61 S LINE=" Recorded: "_$S($P(GMPL1,U,9):$$EXTDT^GMPLX($P(GMPL1,U,9)),1:"date unknown") 62 S:$P(GMPL1,U,4) LINE=LINE_", by "_$P($G(^VA(200,+$P(GMPL1,U,4),0)),U) 63 S LCNT=LCNT+1,GMPDT(LCNT,0)=LINE 64 S LINE=" Entered: "_$$EXTDT^GMPLX($P(GMPL0,U,8)) 65 S LINE=LINE_", by "_$P($G(^VA(200,+$P(GMPL1,U,3),0)),U),LCNT=LCNT+1 66 S:GMPARAM("VER")&($P(GMPL1,U,2)="T") LINE=LINE_" <unconfirmed>" 67 S GMPDT(LCNT,0)=LINE 68 S LINE=" ICD Code: "_$P($G(^ICD9(+GMPL0,0)),U),LCNT=LCNT+1,GMPDT(LCNT,0)=LINE 69 S LCNT=LCNT+1,GMPDT(LCNT,0)=" " 70 PR3 ; Comments 71 S LCNT=LCNT+1,GMPDT(LCNT,0)="Comments:" 72 D CNTRL^VALM10(LCNT,1,8,IOUON,IOUOFF) 73 ; By Facility 74 F FAC=0:0 S FAC=$O(^AUPNPROB(GMPIFN,11,FAC)) Q:+FAC'>0 D 75 . I 'FAC S LCNT=LCNT+1,GMPDT(LCNT,0)=" <None>" G PR4 76 . F NIFN=0:0 S NIFN=$O(^AUPNPROB(GMPIFN,11,FAC,11,NIFN)) Q:+NIFN'>0 D 77 . . S NOTE=$G(^AUPNPROB(GMPIFN,11,FAC,11,NIFN,0)) Q:NOTE="" 78 . . S LINE=$J($$EXTDT^GMPLX($P(NOTE,U,5)),10)_": "_$P(NOTE,U,3) 79 . . S LCNT=LCNT+1,GMPDT(LCNT,0)=LINE 80 . . I $P(NOTE,U,6) S LINE=" "_$P($G(^VA(200,+$P(NOTE,U,6),0)),U),LCNT=LCNT+1,GMPDT(LCNT,0)=LINE 81 S:'($G(NOTE)) LCNT=LCNT+1,GMPDT(LCNT,0)=" <None>" 82 PR4 ; Audit Trail 83 S LCNT=LCNT+1,GMPDT(LCNT,0)=" " 84 S LCNT=LCNT+1,GMPDT(LCNT,0)="History:" 85 D CNTRL^VALM10(LCNT,1,7,IOUON,IOUOFF) 86 I '$D(^GMPL(125.8,"B",GMPIFN)) S LCNT=LCNT+1,GMPDT(LCNT,0)=" <No changes>" G PRQ 87 F IDT=0:0 S IDT=$O(^GMPL(125.8,"AD",GMPIFN,IDT)) Q:IDT'>0 D 88 . F AIFN=0:0 S AIFN=$O(^GMPL(125.8,"AD",GMPIFN,IDT,AIFN)) Q:AIFN'>0 D DT^GMPLHIST 89 PRQ ; Header Node 90 S VALMCNT=LCNT,GMPDT(0)=VALMCNT,VALMSG=$$MSG^GMPLX,VALMBG=1,VALMBCK="R" 91 Q 92 ; 93 HDR ; Header Code (uses GMPDFN, GMPIFN) 94 N LASTMOD,PAT S PAT=$P(GMPDFN,U,2)_" ("_$P(GMPDFN,U,3)_")" 95 S LASTMOD=$S($G(GMPIFN):$P(^AUPNPROB(GMPIFN,0),U,3),1:$E($$HTFM^XLFDT($H),1,12)) 96 S LASTMOD="Last Updated: "_$$FMTE^XLFDT(LASTMOD) 97 S VALMHDR(1)=PAT_$$REPEAT^XLFSTR(" ",(79-$L(PAT)-$L(LASTMOD)))_LASTMOD 98 Q 99 ; 100 HELP ; Help Code 101 N X W !!?4,"You may view detailed information here on this problem;" 102 W !?4,"more data may be available by entering 'Next Screen'." 103 W !?4,"If you have selected multiple problems to view, you may" 104 W !?4,"enter 'Continue to Next Selected Problem'; to return to" 105 W !?4,"the patient's problem list, enter 'Quit to Problem List'." 106 W !!,"Press <return> to continue ... " R X:DTIME 107 S VALMSG=$$MSG^GMPLX,VALMBCK=$S(VALMCC:"",1:"R") 108 Q 109 ; 110 DEFLT() ; Default Action, using GMPI and GMPLNO 111 I GMPI<GMPLNO Q "Continue to Next Selected Problem" 112 Q "Quit to Problem List" 113 ; 114 ERROR ; Error Message - drop into EXIT 115 W !!,"ERROR -- Cannot continue ... Returning to Problem List.",! 116 S VALMBCK="Q" H 1 117 EXIT ; Exit Code 118 K GMPDT Q -
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLEDIT.m
r613 r623 1 GMPLEDIT 2 ;;2.0;Problem List;**26,35**;Aug 25, 1994;Build 26 3 4 5 6 7 8 9 10 11 12 13 14 EN 15 16 17 18 19 20 21 22 INIT 23 24 25 S SP="" F I=1.11,1.12,1.13,1.15,1.16,1.17,1.18S:GMPFLD(I) SP=SP_$P(GMPFLD(I),U,2)_U26 27 28 29 30 31 32 33 34 35 IN1 36 37 38 39 40 IN2 41 42 43 44 45 46 IN3 47 48 49 50 51 52 53 54 55 56 57 58 IN4 59 60 61 62 63 64 65 66 67 68 69 70 71 IN5 72 73 74 75 76 77 78 79 80 81 82 HI(LINE,COL) 83 84 85 86 HDR 87 88 89 90 91 92 93 HELP 94 95 96 97 98 99 100 101 102 103 104 105 EXIT 106 107 108 109 EX1 110 111 112 113 114 115 KILL 116 117 118 119 120 1 GMPLEDIT ; SLC/MKB/KER -- VALM Utilities for Edit sub-list ; 04/15/2002 2 ;;2.0;Problem List;**26**;Aug 25, 1994 3 ; 4 ; External References 5 ; DBIA 10060 ^VA(200 6 ; DBIA 10076 ^XUSEC("GMPL ICD CODE" 7 ; DBIA 10009 YN^DICN 8 ; DBIA 10116 $$SETSTR^VALM1 9 ; DBIA 10117 CLEAN^VALM10 10 ; DBIA 10117 CNTRL^VALM10 11 ; DBIA 10103 $$FMTE^XLFDT 12 ; DBIA 10104 $$REPEAT^XLFSTR 13 ; 14 EN ; Init Variables, list array 15 ; Expects GMPIFN IEN of file 900011 (required) 16 ; GMPLNUM Sequence # of Problem Edit (optional) 17 W !!,"Retrieving current data for problem " 18 W $S($G(GMPLNUM):"#"_GMPLNUM_" ",1:"")_"...",! K GMPFLD,GMPORIG 19 ; Set GMPFLD() and GMPORIG() Arrays 20 D GETFLDS^GMPLEDT3(GMPIFN) 21 I '$D(GMPFLD) W !!,"ERROR -- Cannot continue.",! S VALMBCK="Q" G KILL 22 INIT ; Build list from GMPFLD() 23 N LCNT,TEXT,I,SP,LINE,STR,NUM,NOTE,ICD 24 S LCNT=1,ICD=$S($D(^XUSEC("GMPL ICD CODE",DUZ)):1,1:0) 25 S SP="" F I=1.11,1.12,1.13,1.15,1.16 S:GMPFLD(I) SP=SP_$P(GMPFLD(I),U,2)_U 26 S:$L(SP) SP=$E(SP,1,$L(SP)-1) 27 K GMPSAVED,GMPREBLD D CLEAN^VALM10 28 D WRAP^GMPLX($P(GMPFLD(.05),U,2),65,.TEXT) 29 ; Line 1 30 S LINE="1 Problem: "_TEXT(1) 31 S ^TMP("GMPLEDIT",$J,LCNT,0)=LINE D HI(LCNT,1) 32 I $D(GMPLUSER),GMPARAM("VER"),GMPFLD(1.02)="T" S LINE=$E(LINE,1,12)_"$"_$E(LINE,14,79),^TMP("GMPLEDIT",$J,LCNT,0)=LINE D HI(LCNT,13) 33 I TEXT>1 F I=2:1:TEXT S LCNT=LCNT+1,^TMP("GMPLEDIT",$J,LCNT,0)=" "_TEXT(I) 34 S LCNT=LCNT+1,^TMP("GMPLEDIT",$J,LCNT,0)=" " 35 IN1 ; Line 2 36 S LINE="2 Onset: ",STR=$P(GMPFLD(.13),U,2) 37 S LINE=LINE_$S(STR="":"unknown",1:STR),LCNT=LCNT+1 38 I GMPVA S STR=$S(ICD:7,1:6)_" SC Condition: "_$S(GMPFLD(1.1)="":"unknown",1:$P(GMPFLD(1.1),U,2)),LINE=$$SETSTR^VALM1(STR,LINE,45,34) 39 S ^TMP("GMPLEDIT",$J,LCNT,0)=LINE F I=1,45 D HI(LCNT,I) 40 IN2 ; Line 3 41 S LINE="3 Status: "_$P(GMPFLD(.12),U,2),LCNT=LCNT+1 42 I $E(GMPFLD(.12))="A",$L(GMPFLD(1.14)) S LINE=LINE_"/"_$P(GMPFLD(1.14),U,2) 43 I $E(GMPFLD(.12))="I",GMPFLD(1.07) S LINE=LINE_", Resolved "_$P(GMPFLD(1.07),U,2) 44 I GMPVA S STR=$S(ICD:8,1:7)_" Exposure: "_$S('$L(SP):"<None>",1:$P(SP,U)),LINE=$$SETSTR^VALM1(STR,LINE,45,34) 45 S ^TMP("GMPLEDIT",$J,LCNT,0)=LINE F I=1,45 D HI(LCNT,I) 46 IN3 ; Line 4 47 S LINE="4 Provider: "_$P(GMPFLD(1.05),U,2),LCNT=LCNT+1 48 I GMPVA,$L(SP,U)>1 S STR=$P(SP,U,2),LINE=$$SETSTR^VALM1(STR,LINE,60,20) 49 S ^TMP("GMPLEDIT",$J,LCNT,0)=LINE D HI(LCNT,1) 50 ; Line 5 51 I $E(GMPLVIEW("VIEW"))="S" S LINE="5 Service: "_$P(GMPFLD(1.06),U,2) 52 E S LINE="5 Clinic: "_$P(GMPFLD(1.08),U,2) 53 I GMPVA,$L(SP,U)>2 S STR=$P(SP,U,3),LINE=$$SETSTR^VALM1(STR,LINE,60,20) 54 S LCNT=LCNT+1,^TMP("GMPLEDIT",$J,LCNT,0)=LINE D HI(LCNT,1) G:'ICD IN4 55 ; Line 6 56 S LINE="6 ICD Code: "_$P(GMPFLD(.01),U,2),LCNT=LCNT+1 57 S ^TMP("GMPLEDIT",$J,LCNT,0)=LINE D HI(LCNT,1) 58 IN4 ; Line 7/8 59 S LCNT=LCNT+1,^TMP("GMPLEDIT",$J,LCNT,0)=" " 60 S LCNT=LCNT+1,^TMP("GMPLEDIT",$J,LCNT,0)="Comments: " 61 D CNTRL^VALM10(LCNT,1,8,IOUON,IOUOFF) 62 S NUM=$S(GMPVA:7,1:5) S:ICD NUM=NUM+1 63 I GMPFLD(10,0) F I=1:1:GMPFLD(10,0) D 64 . S NUM=NUM+1,NOTE=GMPFLD(10,I) 65 . S LINE=NUM_$E(" ",1,3-$L(NUM))_$J($$EXTDT^GMPLX($P(NOTE,U,5)),8) 66 . I $P(GMPFLD(10,I),U,3)="",$P(GMPORIG(10,I),U,3)'="" S $P(NOTE,U,3)="<Deleted>" 67 . S LCNT=LCNT+1,^TMP("GMPLEDIT",$J,LCNT,0)=LINE_": "_$P(NOTE,U,3) 68 . D HI(LCNT,1) Q:'$D(GMPLMGR) 69 . S LINE=" "_$P($G(^VA(200,+$P(NOTE,U,6),0)),U) 70 . S LCNT=LCNT+1,^TMP("GMPLEDIT",$J,LCNT,0)=LINE 71 IN5 ; Last Line 72 I $D(GMPFLD(10,"NEW"))>9 S NUM=NUM+1 D 73 . S LINE=NUM_$E(" ",1,3-$L(NUM))_$J($$EXTDT^GMPLX(DT),8)_": " 74 . S I=$O(GMPFLD(10,"NEW",0)),LINE=LINE_GMPFLD(10,"NEW",I) 75 . S LCNT=LCNT+1,^TMP("GMPLEDIT",$J,LCNT,0)=LINE D HI(LCNT,1) 76 . F S I=$O(GMPFLD(10,"NEW",I)) Q:I'>0 D 77 . . S LINE=" "_GMPFLD(10,"NEW",I) 78 . . S LCNT=LCNT+1,^TMP("GMPLEDIT",$J,LCNT,0)=LINE 79 S VALMCNT=LCNT,^TMP("GMPLEDIT",$J,0)=NUM_U_LCNT,VALMSG=$$MSG^GMPLEDT3 80 Q 81 ; 82 HI(LINE,COL) ; Hi-lite # 83 D CNTRL^VALM10(LINE,COL,3,IOINHI,IOINORM) 84 Q 85 ; 86 HDR ; Header code 87 N LASTMOD,PAT S PAT=$P(GMPDFN,U,2)_" ("_$P(GMPDFN,U,3)_")" 88 S LASTMOD=$P(^AUPNPROB(GMPIFN,0),U,3) 89 S LASTMOD="Last Updated: "_$$FMTE^XLFDT(LASTMOD) 90 S VALMHDR(1)=PAT_$$REPEAT^XLFSTR(" ",(79-$L(PAT)-$L(LASTMOD)))_LASTMOD 91 Q 92 ; 93 HELP ; Help code 94 N X,CNT S CNT=+$G(^TMP("GMPLEDIT",$J,0)) 95 W !!?4,"You may change one or more of the above listed values describing" 96 W !?4,"this problem by entering its display number (1-"_CNT_") at the prompt;" 97 W !?4,"you may then enter a new value, or '@' to delete an existing value." 98 W !!?4,"Enter RM to remove this problem from the patient's list completely," 99 W !?4,"SC to save your changes, or Q to simply return to the problem list." 100 W:VALMCNT>11 !?4,"Enter '+' to see more information, as in the problem list." 101 W !!,"Press <return> to continue ... " R X:DTIME 102 S VALMSG=$$MSG^GMPLEDT3,VALMBCK=$S(VALMCC:"",1:"R") 103 Q 104 ; 105 EXIT ; Exit code 106 N DIFFRENT,% G:$D(GMPSAVED) KILL 107 S DIFFRENT=$$EDITED^GMPLEDT2 I 'DIFFRENT G KILL 108 W $C(7),!!,">>> THIS PROBLEM HAS CHANGED!!" 109 EX1 ; Ask to Save Changes on Exit 110 W !?5,"Do you want to save these changes" 111 S %=1 D YN^DICN G:(%<0)!(%=2) KILL I %=0 D G EX1 112 . W !!?5,"Enter YES or <return> to save the current values listed above" 113 . W !?5,"describing this problem; enter NO to exit without saving.",! 114 W !!,"Saving ..." D EN^GMPLSAVE W " done." 115 KILL ; Clean-up 116 S CNT=+$G(^TMP("GMPLEDIT",$J,0)) 117 F I=1:1:CNT K XQORM("KEY",I) 118 D CLEAN^VALM10 K XQORM("KEY","$") 119 K GMPFLD,GMPORIG,GMPQUIT,DUOUT,DTOUT,I,CNT 120 Q -
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLEDT1.m
r613 r623 1 GMPLEDT1 ; SLC/MKB/KER/AJB -- Edit Problem List fields ; 04/21/2003 2 ;;2.0;Problem List;**17,20,26,28,35**;Aug 25, 1994;Build 26 3 ; 4 ; External References 5 ; DBIA 10006 ^DIC 6 ; DBIA 10026 ^DIR 7 ; DBIA 341 DIS^SDROUT2 8 ; 9 ONSET ; Edit Date of Onset - field .13 10 N X,Y,ENTERED,PROMPT,HELPMSG,DEFAULT 11 S ENTERED=$S($G(GMPFLD(.08)):+GMPFLD(.08),1:DT),DEFAULT=$G(GMPFLD(.13)) 12 S PROMPT="DATE OF ONSET: ",HELPMSG="Enter the date this problem was first observed, as precisely as known." 13 O1 ; Get Date of Onset 14 D DATE^GMPLEDT2 Q:$D(GMPQUIT)!($G(GMPLJUMP)) 15 I Y>ENTERED W !!,"Date of Onset cannot be later than the date the problem was entered!",$C(7) G O1 16 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 17 S GMPFLD(.13)=Y S:Y'="" GMPFLD(.13)=GMPFLD(.13)_U_$$EXTDT^GMPLX(Y) 18 Q 19 STATUS ; Edit Status - field .12 20 ; Then Edit Date Resolved - Field 1.07, if inactive 21 N DIR,X,Y 22 S DIR(0)="9000011,.12" 23 S:$L($G(GMPFLD(.12))) DIR("B")=$P(GMPFLD(.12),U,2) 24 ST1 ; Get Status 25 D ^DIR I $D(DTOUT)!(Y="^") S GMPQUIT=1 Q 26 I Y?1"^".E D JUMP^GMPLEDT3(Y) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G ST1 27 S:Y'="" Y=Y_U_$S(Y="A":"ACTIVE",1:"INACTIVE") S GMPFLD(.12)=Y 28 S:$E(Y)'="I" GMPFLD(1.07)="" S:$E(Y)'="A" GMPFLD(1.14)="" 29 D:$E(GMPFLD(.12))="I" RESOLVED^GMPLEDT4 30 D:$E(GMPFLD(.12))="A" PRIORITY^GMPLEDT4 31 Q 32 RECORDED ; Edit Date Recorded - field 1.09 33 N X,Y,PROMPT,HELPMSG,DEFAULT,ENTERED 34 S ENTERED=$S($G(GMPFLD(.08)):+GMPFLD(.08),1:DT),DEFAULT=$G(GMPFLD(1.09)) 35 S PROMPT="DATE RECORDED: ",HELPMSG="Enter the date this problem was first recorded, as precisely as known." 36 RC1 ; Get Date 37 D DATE^GMPLEDT2 Q:$D(GMPQUIT)!($G(GMPLJUMP)) 38 I Y>ENTERED W !!,"Date Recorded cannot be later than the problem was entered!",$C(7) G RC1 39 S GMPFLD(1.09)=Y S:Y'="" GMPFLD(1.09)=GMPFLD(1.09)_U_$$EXTDT^GMPLX(Y) 40 Q 41 SC ; Edit Service Connected - field 1.1 42 N DFN,DIR,X,Y 43 ; 44 ; The following allows changing a problem's SC/NSC to 45 ; NSC if there is no SC on file for patient and Problem 46 ; original SC was set to "YES" 47 ; 48 I +$G(GMPORIG(1.1))=1 D 49 . W !!,">>> Currently known service-connection data for "_$P(GMPDFN,U,2)_":" 50 ELSE Q:'GMPSC 51 S DFN=+GMPDFN D DIS^SDROUT2 52 I +GMPSC=0,+$G(GMPORIG(1.1))=1 D 53 . S DIR("A")="Patient has no service-connected condition !! " 54 . S DIR("B")="NO" 55 ELSE D 56 . S DIR("A")="Is this problem related to a service-connected condition? " 57 . S:$L($G(GMPFLD(1.1))) DIR("B")=$P(GMPFLD(1.1),U,2) W ! 58 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" 59 SC1 ; Get Service Connection 60 D ^DIR I $D(DTOUT)!(Y="^") S GMPQUIT=1 Q 61 I Y?1"^".E D JUMP^GMPLEDT3(Y) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G SC1 62 I X="@" G:'$$SURE^GMPLX SC1 S Y="" 63 S GMPFLD(1.1)=Y S:Y'="" GMPFLD(1.1)=GMPFLD(1.1)_U_$S(Y:"YES",1:"NO") 64 Q 65 SP ; Edit Exposures/Conditions 66 ; Agent Orange - field 1.11 67 ; Ionizing Radiation - field 1.12 68 ; Persian Gulf/Environmental Contaminants - field 1.13 69 ; Head and/or Neck Cancer - field 1.15 70 ; Military Sexual Trauma - field 1.16 71 ; Combat Vet - field 1.17 72 ; SHAD - field 1.18 73 G SPEXP^GMPLEDT2 74 Q 75 SOURCE ; Edit Service - field 1.06 76 ; or Clinic - field 1.08 77 N DIC,X,Y,HELPMSG,PROMPT,DEFAULT,VIEW S VIEW=$E(GMPLVIEW("VIEW")) 78 S DIC=$S(VIEW="S":"^DIC(49,",1:"^SC("),DIC(0)="EMQ" 79 S DIC("S")="I $P(^(0),U,"_$S(VIEW="S":9,1:3)_")=""C""" 80 I VIEW="S" S PROMPT="SERVICE: ",DEFAULT=$P(GMPFLD(1.06),U,2) 81 E S PROMPT="CLINIC: ",DEFAULT=$P(GMPFLD(1.08),U,2) 82 S HELPMSG="Enter the clinic"_$S(VIEW="S":"al service",1:"")_" to be associated with this problem." 83 S1 ; Get Service/Clinic 84 W !,PROMPT_$S($L(DEFAULT):DEFAULT_"//",1:"") 85 R X:DTIME S:'$T X="^",DTOUT=1 S:X="^" GMPQUIT=1 Q:(X="^")!(X="") 86 I X?1"^".E D JUMP^GMPLEDT3(X) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G S1 87 I X="?" W !!,HELPMSG,! G S1 88 I X["??" D @("LIST"_$S(VIEW="S":"SERV",1:"CLIN")_"^GMPLMGR1") W !,HELPMSG G S1 89 I X="@" G:'$$SURE^GMPLX S1 S Y="" G SQ 90 D ^DIC I Y'>0 W !?5,"Only clinic"_$S(VIEW="S":"al service",1:"")_"s are allowed!",! G S1 91 SQ ; Quit Service/Clinic 92 S:VIEW'="S" GMPFLD(1.08)=Y S:VIEW="S" GMPFLD(1.06)=Y 93 Q 94 AUTHOR ; Edit Recording Provider - field 1.04 95 N X,Y,PROMPT,HELPMSG,DEFAULT S PROMPT="RECORDING PROVIDER: " 96 S DEFAULT=$G(GMPFLD(1.04)),HELPMSG="Enter the name of the provider responsible for the recording of this data." 97 D NPERSON^GMPLEDT2 Q:$D(GMPQUIT)!($G(GMPLJUMP)) 98 S GMPFLD(1.04)=$S(+Y>0:Y,1:"") 99 Q 100 PROV ; Edit Responsible Provider - field 1.05 101 N X,Y,PROMPT,DEFAULT,HELPMSG S DEFAULT=$G(GMPFLD(1.05)) 102 S PROMPT="PROVIDER: ",HELPMSG="Enter the name of the local provider treating this problem." 103 D NPERSON^GMPLEDT2 Q:$D(GMPQUIT)!($G(GMPLJUMP)) 104 S GMPFLD(1.05)=$S(+Y>0:Y,1:"") 105 Q 106 ICD ; Edit ICD-9-CM Code - field .01 107 N DIC,DIR,X,Y 108 ICD0 ; Prompt for ICD Code 109 K DIR S DIR(0)="FAO^2:6",DIR("A")="ICD CODE: " 110 S:$P($G(GMPFLD(.01)),U,2)="799.9" DIR("A")=IORVON_"ICD CODE: " 111 S:+$G(GMPFLD(.01)) DIR("B")=$P(GMPFLD(.01),U,2) 112 S DIR("?")="Enter the ICD code to be associated with this problem" 113 ICD1 ; Get ICD Code 114 D ^DIR W IORVOFF I $D(DTOUT)!(Y="^") S GMPQUIT=1 Q 115 I Y?1"^".E D JUMP^GMPLEDT3(Y) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G ICD1 116 I X="@" W !!,"ICD Code may not be deleted!",!,$C(7) G ICD1 117 Q:X="" Q:$P($G(GMPFLD(.01)),U,2)=Y 118 S DIC=80,DIC(0)="EQM" D ^DIC G:Y'>0 ICD0 119 S GMPFLD(.01)=Y 120 Q 121 NOTE ; Attach a note to problem - field 11 122 N X,Y,I,DEFAULT,PROMPT,DONE,NXT,NCNT S (I,NCNT,DONE)=0 123 ; added for Code Set Versioning (CSV) 124 I $G(GMPICD),'+$$STATCHK^ICDAPIU(GMPICD,DT) D Q 125 . W !!,"This problem has an inactive ICD code. Please edit the problem before using.",! H 3 126 I $G(GMPIFN),'$$CODESTS^GMPLX(GMPIFN,DT) D Q 127 . W !!,"This problem has an inactive ICD code. Please edit the problem before using.",! H 3 128 F D Q:$D(GMPQUIT)!($G(GMPLJUMP))!DONE 129 . S NXT=$O(GMPFLD(10,"NEW",I)) S:'NXT NXT=I+1 130 . S I=NXT,NCNT=NCNT+1 131 . S PROMPT=$S(NCNT=1:"",1:"ANOTHER ")_"COMMENT"_$S(NCNT=1:" (<60 char): ",1:": "),DEFAULT=$G(GMPFLD(10,"NEW",I)) 132 . D EDNOTE^GMPLEDT4 Q:$D(GMPQUIT)!($G(GMPLJUMP)) 133 . I X="@" K GMPFLD(10,"NEW",I) Q 134 . I Y="" S DONE=1 Q 135 . S GMPFLD(10,"NEW",I)=Y 136 Q 137 TERM ; Edit Problem - field 1.01 138 G TERM^GMPLEDT4 139 Q 140 Q ; No Editing 141 Q 1 GMPLEDT1 ; SLC/MKB/KER/AJB -- Edit Problem List fields ; 04/21/2003 2 ;;2.0;Problem List;**17,20,26,28**;Aug 25, 1994 3 ; 4 ; External References 5 ; DBIA 10006 ^DIC 6 ; DBIA 10026 ^DIR 7 ; DBIA 341 DIS^SDROUT2 8 ; 9 ONSET ; Edit Date of Onset - field .13 10 N X,Y,ENTERED,PROMPT,HELPMSG,DEFAULT 11 S ENTERED=$S($G(GMPFLD(.08)):+GMPFLD(.08),1:DT),DEFAULT=$G(GMPFLD(.13)) 12 S PROMPT="DATE OF ONSET: ",HELPMSG="Enter the date this problem was first observed, as precisely as known." 13 O1 ; Get Date of Onset 14 D DATE^GMPLEDT2 Q:$D(GMPQUIT)!($G(GMPLJUMP)) 15 I Y>ENTERED W !!,"Date of Onset cannot be later than the date the problem was entered!",$C(7) G O1 16 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 17 S GMPFLD(.13)=Y S:Y'="" GMPFLD(.13)=GMPFLD(.13)_U_$$EXTDT^GMPLX(Y) 18 Q 19 STATUS ; Edit Status - field .12 20 ; Then Edit Date Resolved - Field 1.07, if inactive 21 N DIR,X,Y 22 S DIR(0)="9000011,.12" 23 S:$L($G(GMPFLD(.12))) DIR("B")=$P(GMPFLD(.12),U,2) 24 ST1 ; Get Status 25 D ^DIR I $D(DTOUT)!(Y="^") S GMPQUIT=1 Q 26 I Y?1"^".E D JUMP^GMPLEDT3(Y) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G ST1 27 S:Y'="" Y=Y_U_$S(Y="A":"ACTIVE",1:"INACTIVE") S GMPFLD(.12)=Y 28 S:$E(Y)'="I" GMPFLD(1.07)="" S:$E(Y)'="A" GMPFLD(1.14)="" 29 D:$E(GMPFLD(.12))="I" RESOLVED^GMPLEDT4 30 D:$E(GMPFLD(.12))="A" PRIORITY^GMPLEDT4 31 Q 32 RECORDED ; Edit Date Recorded - field 1.09 33 N X,Y,PROMPT,HELPMSG,DEFAULT,ENTERED 34 S ENTERED=$S($G(GMPFLD(.08)):+GMPFLD(.08),1:DT),DEFAULT=$G(GMPFLD(1.09)) 35 S PROMPT="DATE RECORDED: ",HELPMSG="Enter the date this problem was first recorded, as precisely as known." 36 RC1 ; Get Date 37 D DATE^GMPLEDT2 Q:$D(GMPQUIT)!($G(GMPLJUMP)) 38 I Y>ENTERED W !!,"Date Recorded cannot be later than the problem was entered!",$C(7) G RC1 39 S GMPFLD(1.09)=Y S:Y'="" GMPFLD(1.09)=GMPFLD(1.09)_U_$$EXTDT^GMPLX(Y) 40 Q 41 SC ; Edit Service Connected - field 1.1 42 N DFN,DIR,X,Y 43 ; 44 ; The following allows changing a problem's SC/NSC to 45 ; NSC if there is no SC on file for patient and Problem 46 ; original SC was set to "YES" 47 ; 48 I +$G(GMPORIG(1.1))=1 D 49 . W !!,">>> Currently known service-connection data for "_$P(GMPDFN,U,2)_":" 50 ELSE Q:'GMPSC 51 S DFN=+GMPDFN D DIS^SDROUT2 52 I +GMPSC=0,+$G(GMPORIG(1.1))=1 D 53 . S DIR("A")="Patient has no service-connected condition !! " 54 . S DIR("B")="NO" 55 ELSE D 56 . S DIR("A")="Is this problem related to a service-connected condition? " 57 . S:$L($G(GMPFLD(1.1))) DIR("B")=$P(GMPFLD(1.1),U,2) W ! 58 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" 59 SC1 ; Get Service Connection 60 D ^DIR I $D(DTOUT)!(Y="^") S GMPQUIT=1 Q 61 I Y?1"^".E D JUMP^GMPLEDT3(Y) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G SC1 62 I X="@" G:'$$SURE^GMPLX SC1 S Y="" 63 S GMPFLD(1.1)=Y S:Y'="" GMPFLD(1.1)=GMPFLD(1.1)_U_$S(Y:"YES",1:"NO") 64 Q 65 SP ; Edit Exposures/Conditions 66 ; Agent Orange - field 1.11 67 ; Ionizing Radiation - field 1.12 68 ; Persian Gulf/Environmental Contaminants - field 1.13 69 ; Head and/or Neck Cancer - field 1.15 70 ; Military Sexual Trauma - field 1.16 71 G SPEXP^GMPLEDT2 72 Q 73 SOURCE ; Edit Service - field 1.06 74 ; or Clinic - field 1.08 75 N DIC,X,Y,HELPMSG,PROMPT,DEFAULT,VIEW S VIEW=$E(GMPLVIEW("VIEW")) 76 S DIC=$S(VIEW="S":"^DIC(49,",1:"^SC("),DIC(0)="EMQ" 77 S DIC("S")="I $P(^(0),U,"_$S(VIEW="S":9,1:3)_")=""C""" 78 I VIEW="S" S PROMPT="SERVICE: ",DEFAULT=$P(GMPFLD(1.06),U,2) 79 E S PROMPT="CLINIC: ",DEFAULT=$P(GMPFLD(1.08),U,2) 80 S HELPMSG="Enter the clinic"_$S(VIEW="S":"al service",1:"")_" to be associated with this problem." 81 S1 ; Get Service/Clinic 82 W !,PROMPT_$S($L(DEFAULT):DEFAULT_"//",1:"") 83 R X:DTIME S:'$T X="^",DTOUT=1 S:X="^" GMPQUIT=1 Q:(X="^")!(X="") 84 I X?1"^".E D JUMP^GMPLEDT3(X) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G S1 85 I X="?" W !!,HELPMSG,! G S1 86 I X["??" D @("LIST"_$S(VIEW="S":"SERV",1:"CLIN")_"^GMPLMGR1") W !,HELPMSG G S1 87 I X="@" G:'$$SURE^GMPLX S1 S Y="" G SQ 88 D ^DIC I Y'>0 W !?5,"Only clinic"_$S(VIEW="S":"al service",1:"")_"s are allowed!",! G S1 89 SQ ; Quit Service/Clinic 90 S:VIEW'="S" GMPFLD(1.08)=Y S:VIEW="S" GMPFLD(1.06)=Y 91 Q 92 AUTHOR ; Edit Recording Provider - field 1.04 93 N X,Y,PROMPT,HELPMSG,DEFAULT S PROMPT="RECORDING PROVIDER: " 94 S DEFAULT=$G(GMPFLD(1.04)),HELPMSG="Enter the name of the provider responsible for the recording of this data." 95 D NPERSON^GMPLEDT2 Q:$D(GMPQUIT)!($G(GMPLJUMP)) 96 S GMPFLD(1.04)=$S(+Y>0:Y,1:"") 97 Q 98 PROV ; Edit Responsible Provider - field 1.05 99 N X,Y,PROMPT,DEFAULT,HELPMSG S DEFAULT=$G(GMPFLD(1.05)) 100 S PROMPT="PROVIDER: ",HELPMSG="Enter the name of the local provider treating this problem." 101 D NPERSON^GMPLEDT2 Q:$D(GMPQUIT)!($G(GMPLJUMP)) 102 S GMPFLD(1.05)=$S(+Y>0:Y,1:"") 103 Q 104 ICD ; Edit ICD-9-CM Code - field .01 105 N DIC,DIR,X,Y 106 ICD0 ; Prompt for ICD Code 107 K DIR S DIR(0)="FAO^2:6",DIR("A")="ICD CODE: " 108 S:$P($G(GMPFLD(.01)),U,2)="799.9" DIR("A")=IORVON_"ICD CODE: " 109 S:+$G(GMPFLD(.01)) DIR("B")=$P(GMPFLD(.01),U,2) 110 S DIR("?")="Enter the ICD code to be associated with this problem" 111 ICD1 ; Get ICD Code 112 D ^DIR W IORVOFF I $D(DTOUT)!(Y="^") S GMPQUIT=1 Q 113 I Y?1"^".E D JUMP^GMPLEDT3(Y) Q:$D(GMPQUIT)!($G(GMPLJUMP)) K:$G(GMPIFN) GMPLJUMP G ICD1 114 I X="@" W !!,"ICD Code may not be deleted!",!,$C(7) G ICD1 115 Q:X="" Q:$P($G(GMPFLD(.01)),U,2)=Y 116 S DIC=80,DIC(0)="EQM" D ^DIC G:Y'>0 ICD0 117 S GMPFLD(.01)=Y 118 Q 119 NOTE ; Attach a note to problem - field 11 120 N X,Y,I,DEFAULT,PROMPT,DONE,NXT,NCNT S (I,NCNT,DONE)=0 121 ; added for Code Set Versioning (CSV) 122 I $G(GMPICD),'+$$STATCHK^ICDAPIU(GMPICD,DT) D Q 123 . W !!,"This problem has an inactive ICD code. Please edit the problem before using.",! H 3 124 I $G(GMPIFN),'$$CODESTS^GMPLX(GMPIFN,DT) D Q 125 . W !!,"This problem has an inactive ICD code. Please edit the problem before using.",! H 3 126 F D Q:$D(GMPQUIT)!($G(GMPLJUMP))!DONE 127 . S NXT=$O(GMPFLD(10,"NEW",I)) S:'NXT NXT=I+1 128 . S I=NXT,NCNT=NCNT+1 129 . S PROMPT=$S(NCNT=1:"",1:"ANOTHER ")_"COMMENT"_$S(NCNT=1:" (<60 char): ",1:": "),DEFAULT=$G(GMPFLD(10,"NEW",I)) 130 . D EDNOTE^GMPLEDT4 Q:$D(GMPQUIT)!($G(GMPLJUMP)) 131 . I X="@" K GMPFLD(10,"NEW",I) Q 132 . I Y="" S DONE=1 Q 133 . S GMPFLD(10,"NEW",I)=Y 134 Q 135 TERM ; Edit Problem - field 1.01 136 G TERM^GMPLEDT4 137 Q 138 Q ; No Editing 139 Q -
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 -
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLEDT3.m
r613 r623 1 GMPLEDT3 ; SLC/MKB/KER -- Problem List edit utilities ; 04/15/2002 2 ;;2.0;Problem List;**26,35**;Aug 25, 1994;Build 26 3 ; 4 ; External References 5 ; DBIA 872 ^ORD(101 6 ; DBIA 10026 ^XUSEC("GMPL ICD CODE" 7 ; DBIA 10015 EN^DIQ1 8 ; DBIA 10026 ^DIR 9 ; DBIA 10104 $$UP^XLFSTR 10 ; 11 MSG() ; List Manager Message Bar 12 Q "Enter the number of the item(s) you wish to change" 13 ; 14 KEYS ; Setup XQORM("KEY") array 15 ; Numbers ref'd also in IN4^-EDIT, NTES^-EDT4 16 N I,PROTCL,NUM,ICD 17 S ICD=$S($D(^XUSEC("GMPL ICD CODE",DUZ)):1,1:0) 18 S XQORM("KEY","1")=$O(^ORD(101,"B","GMPL EDIT REFORMULATE",0))_"^1" 19 S XQORM("KEY","2")=$O(^ORD(101,"B","GMPL EDIT ONSET",0))_"^1" 20 S XQORM("KEY","3")=$O(^ORD(101,"B","GMPL EDIT STATUS",0))_"^1" 21 S XQORM("KEY","4")=$O(^ORD(101,"B","GMPL EDIT PROVIDER",0))_"^1" 22 S XQORM("KEY","5")=$O(^ORD(101,"B","GMPL EDIT SERVICE",0))_"^1",NUM=5 23 S:ICD XQORM("KEY","6")=$O(^ORD(101,"B","GMPL EDIT ICD",0))_"^1",NUM=6 24 I GMPVA D 25 . S NUM=NUM+1,XQORM("KEY",NUM)=$O(^ORD(101,"B","GMPL EDIT SC",0))_"^1" 26 . S NUM=NUM+1,XQORM("KEY",NUM)=$O(^ORD(101,"B","GMPL EDIT SP",0))_"^1" 27 S PROTCL=$O(^ORD(101,"B","GMPL EDIT NOTES",0))_"^1" 28 I GMPFLD(10,0) F I=1:1:GMPFLD(10,0) S NUM=NUM+1,XQORM("KEY",NUM)=PROTCL 29 S XQORM("KEY",NUM+1)=$O(^ORD(101,"B","GMPL EDIT NEW NOTE",0))_"^1" 30 S:$G(GMPARAM("VER"))&$D(GMPLUSER) XQORM("KEY","$")=$O(^ORD(101,"B","GMPL EDIT VERIFY",0))_"^1" 31 S XQORM("KEY","=")=$O(^ORD(101,"B","VALM NEXT SCREEN",0))_"^1" 32 S VALMSG=$$MSG 33 Q 34 ; 35 GETFLDS(DA) ; Define GMPFLD(#) and GMPORIG(#) Arrays with Current Values 36 N DIC,DIQ,DR,I,GMPL,CNT,NIFN,FAC,EXT 37 S DIC="^AUPNPROB(",DIQ="GMPL",DIQ(0)="IE" 38 S DR=".01;.03;.05;.08:1.02;1.05:1.18" D EN^DIQ1 39 F I=.01,.03,.05,.08,.12,.13,1.01,1.02,1.05,1.06,1.07,1.08,1.09,1.1,1.11,1.12,1.13,1.14,1.15,1.16,1.17,1.18 D 40 . S GMPORIG(I)=$G(GMPL(9000011,DA,I,"I")),EXT="" 41 . I I=1.01,GMPL(9000011,DA,I,"I")'>1 S GMPORIG(I)="" Q 42 . Q:(GMPORIG(I)="")!(I=1.02) 43 . I "^.01^.05^.12^1.01^1.05^1.06^1.08^1.1^1.14^"[(U_I_U) S EXT=GMPL(9000011,DA,I,"E") 44 . I "^.03^.08^.13^1.07^1.09^"[(U_I_U) S EXT=$$EXTDT^GMPLX(GMPORIG(I)) 45 . I "^1.11^1.12^1.13^"[(U_I_U) S EXT=$S(I=1.11:"AGENT ORANGE",I=1.12:"RADIATION",1:"ENV CONTAMINANTS") 46 . I "^1.15^1.16^1.17^1.18^"[(U_I_U) S EXT=$S(I=1.15:"HEAD/NECK CANCER",1=1.16:"MIL SEXUAL TRAUMA",1=1.17:"COMBAT VET",1:"SHAD") 47 . S GMPORIG(I)=GMPORIG(I)_U_EXT 48 S I=0 F S I=$O(GMPORIG(I)) Q:I'>0 S GMPFLD(I)=GMPORIG(I) 49 S (CNT,GMPORIG(10,0),GMPFLD(10,0))=0 50 S FAC=$O(^AUPNPROB(DA,11,"B",+GMPVAMC,0)) Q:'FAC 51 F NIFN=0:0 S NIFN=$O(^AUPNPROB(DA,11,FAC,11,"B",NIFN)) Q:NIFN'>0 D 52 . I '$D(GMPLMGR),$P($G(^AUPNPROB(DA,11,FAC,11,NIFN,0)),U,6)'=+GMPROV Q 53 . S CNT=CNT+1,GMPORIG(10,CNT)=$G(^AUPNPROB(DA,11,FAC,11,NIFN,0)) 54 . S $P(GMPORIG(10,CNT),U,2)=FAC 55 . S GMPFLD(10,CNT)=GMPORIG(10,CNT) 56 S (GMPORIG(10,0),GMPFLD(10,0))=CNT 57 Q 58 ; 59 FLDS ; Define GMPFLD("FLD") Array for Editing 60 S (GMPFLD("FLD",2),GMPFLD("FLD",6),GMPFLD("FLD",7))="Q" 61 S GMPFLD("FLD",1)="TERM",GMPFLD("FLD","PROBLEM")=1 62 S:$D(^XUSEC("GMPL ICD CODE",DUZ)) GMPFLD("FLD",2)="ICD",GMPFLD("FLD","ICD CODE")=2 63 S GMPFLD("FLD",3)="NOTE",GMPFLD("FLD","COMMENT")=3 64 S GMPFLD("FLD",4)="ONSET",GMPFLD("FLD","DATE OF ONSET")=4 65 S GMPFLD("FLD",5)="STATUS",GMPFLD("FLD","STATUS")=5 66 S:GMPSC GMPFLD("FLD",6)="SC",GMPFLD("FLD","IS THIS PROBLEM RELATED TO A SERVICE-CONNECTED CONDITION?")=6 67 S:GMPAGTOR GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO AGENT ORANGE EXPOSURE?")=7 68 S:GMPION GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO RADIATION EXPOSURE?")=7 69 S:GMPGULF GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO ENVIRONMENTAL CONTAMINANTS EXPOSURE?")=7 70 S:GMPHNC GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO DIAGNOSED HEAD AND/OR NECK CANCER?")=7 71 S:GMPMST GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO REPORTED MILITARY SEXUAL TRAUMA?")=7 72 S:GMPCV GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO REPORTED COMBAT VET?")=7 73 S:GMPSHD GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO REPORTED SHIPBOARD HAZARD AND DEFENSE?")=7 74 S GMPFLD("FLD",8)="PROV",GMPFLD("FLD","RESPONSIBLE PROVIDER")=8 75 S GMPFLD("FLD",9)="SOURCE" 76 S:$E(GMPLVIEW("VIEW"))="C" GMPFLD("FLD","CLINIC")=9 77 S:$E(GMPLVIEW("VIEW"))'="C" GMPFLD("FLD","SERVICE")=9 78 S GMPFLD("FLD",10)="RECORDED",GMPFLD("FLD","DATE RECORDED")=10 79 S GMPFLD("FLD",11)="AUTHOR",GMPFLD("FLD","RECORDING PROVIDER")=11 80 S GMPFLD("FLD",0)=11 81 Q 82 ; 83 JUMP(XFLD) ; Resolve ^- Jump Out of Field Order in Edit 84 N I,MATCH,CNT,PROMPT,DIR,X,Y 85 ; Passed in as ^XXX 86 S XFLD=$$UP^XLFSTR($P(XFLD,U,2)) 87 I (XFLD="")!(XFLD["^") S GMPQUIT=1 Q 88 I '$D(GMPLJUMP) W $C(7)," ^-jumping not allowed now!" S GMPLJUMP=0 Q 89 ; Field is Exact 90 I $G(GMPFLD("FLD",XFLD)) S GMPLJUMP=GMPFLD("FLD",XFLD) Q 91 S CNT=0,PROMPT=" " 92 F S PROMPT=$O(GMPFLD("FLD",PROMPT)) Q:PROMPT="" D 93 . Q:$E(PROMPT,1,$L(XFLD))'=XFLD 94 . S CNT=CNT+1,MATCH(CNT)=GMPFLD("FLD",PROMPT)_U_PROMPT 95 I CNT=0 W $C(7)," ??" Q 96 I CNT=1 S PROMPT=$P(MATCH(1),U,2),GMPLJUMP=+MATCH(1) W $E(PROMPT,$L(XFLD)+1,$L(PROMPT)) Q 97 ; Select which Field to Jump To. 98 F I=1:1:CNT S DIR("A",I)=I_" "_$P(MATCH(I),U,2) 99 S DIR("A")="Select 1-"_CNT_": ",DIR(0)="NAO^1:"_CNT 100 S DIR("?")="Select the field you wish to jump to, by number" 101 D ^DIR I $D(DTOUT)!($D(DUOUT))!(Y="") Q 102 S GMPLJUMP=+MATCH(+Y) 103 Q 104 ; 105 CK ; Check whether to Stop Processing 106 ; Called from Exit Action of GMPL EDIT XXX Protocols 107 S:$D(GMPQUIT) XQORPOP=1 S:'$D(GMPQUIT) GMPREBLD=1 K GMPQUIT 108 I $D(DTOUT)!($G(VALMBCK)="Q") S VALMBCK="Q" Q 109 S VALMBCK="R",VALMSG=$$MSG 110 Q 1 GMPLEDT3 ; SLC/MKB/KER -- Problem List edit utilities ; 04/15/2002 2 ;;2.0;Problem List;**26**;Aug 25, 1994 3 ; 4 ; External References 5 ; DBIA 872 ^ORD(101 6 ; DBIA 10026 ^XUSEC("GMPL ICD CODE" 7 ; DBIA 10015 EN^DIQ1 8 ; DBIA 10026 ^DIR 9 ; DBIA 10104 $$UP^XLFSTR 10 ; 11 MSG() ; List Manager Message Bar 12 Q "Enter the number of the item(s) you wish to change" 13 ; 14 KEYS ; Setup XQORM("KEY") array 15 ; Numbers ref'd also in IN4^-EDIT, NTES^-EDT4 16 N I,PROTCL,NUM,ICD 17 S ICD=$S($D(^XUSEC("GMPL ICD CODE",DUZ)):1,1:0) 18 S XQORM("KEY","1")=$O(^ORD(101,"B","GMPL EDIT REFORMULATE",0))_"^1" 19 S XQORM("KEY","2")=$O(^ORD(101,"B","GMPL EDIT ONSET",0))_"^1" 20 S XQORM("KEY","3")=$O(^ORD(101,"B","GMPL EDIT STATUS",0))_"^1" 21 S XQORM("KEY","4")=$O(^ORD(101,"B","GMPL EDIT PROVIDER",0))_"^1" 22 S XQORM("KEY","5")=$O(^ORD(101,"B","GMPL EDIT SERVICE",0))_"^1",NUM=5 23 S:ICD XQORM("KEY","6")=$O(^ORD(101,"B","GMPL EDIT ICD",0))_"^1",NUM=6 24 I GMPVA D 25 . S NUM=NUM+1,XQORM("KEY",NUM)=$O(^ORD(101,"B","GMPL EDIT SC",0))_"^1" 26 . S NUM=NUM+1,XQORM("KEY",NUM)=$O(^ORD(101,"B","GMPL EDIT SP",0))_"^1" 27 S PROTCL=$O(^ORD(101,"B","GMPL EDIT NOTES",0))_"^1" 28 I GMPFLD(10,0) F I=1:1:GMPFLD(10,0) S NUM=NUM+1,XQORM("KEY",NUM)=PROTCL 29 S XQORM("KEY",NUM+1)=$O(^ORD(101,"B","GMPL EDIT NEW NOTE",0))_"^1" 30 S:$G(GMPARAM("VER"))&$D(GMPLUSER) XQORM("KEY","$")=$O(^ORD(101,"B","GMPL EDIT VERIFY",0))_"^1" 31 S XQORM("KEY","=")=$O(^ORD(101,"B","VALM NEXT SCREEN",0))_"^1" 32 S VALMSG=$$MSG 33 Q 34 ; 35 GETFLDS(DA) ; Define GMPFLD(#) and GMPORIG(#) Arrays with Current Values 36 N DIC,DIQ,DR,I,GMPL,CNT,NIFN,FAC,EXT 37 S DIC="^AUPNPROB(",DIQ="GMPL",DIQ(0)="IE" 38 S DR=".01;.03;.05;.08:1.02;1.05:1.16" D EN^DIQ1 39 F I=.01,.03,.05,.08,.12,.13,1.01,1.02,1.05,1.06,1.07,1.08,1.09,1.1,1.11,1.12,1.13,1.14,1.15,1.16 D 40 . S GMPORIG(I)=$G(GMPL(9000011,DA,I,"I")),EXT="" 41 . I I=1.01,GMPL(9000011,DA,I,"I")'>1 S GMPORIG(I)="" Q 42 . Q:(GMPORIG(I)="")!(I=1.02) 43 . I "^.01^.05^.12^1.01^1.05^1.06^1.08^1.1^1.14^"[(U_I_U) S EXT=GMPL(9000011,DA,I,"E") 44 . I "^.03^.08^.13^1.07^1.09^"[(U_I_U) S EXT=$$EXTDT^GMPLX(GMPORIG(I)) 45 . I "^1.11^1.12^1.13^"[(U_I_U) S EXT=$S(I=1.11:"AGENT ORANGE",I=1.12:"RADIATION",1:"ENV CONTAMINANTS") 46 . I "^1.15^1.16^"[(U_I_U) S EXT=$S(I=1.15:"HEAD/NECK CANCER",1:"MIL SEXUAL TRAUMA") 47 . S GMPORIG(I)=GMPORIG(I)_U_EXT 48 S I=0 F S I=$O(GMPORIG(I)) Q:I'>0 S GMPFLD(I)=GMPORIG(I) 49 S (CNT,GMPORIG(10,0),GMPFLD(10,0))=0 50 S FAC=$O(^AUPNPROB(DA,11,"B",+GMPVAMC,0)) Q:'FAC 51 F NIFN=0:0 S NIFN=$O(^AUPNPROB(DA,11,FAC,11,"B",NIFN)) Q:NIFN'>0 D 52 . I '$D(GMPLMGR),$P($G(^AUPNPROB(DA,11,FAC,11,NIFN,0)),U,6)'=+GMPROV Q 53 . S CNT=CNT+1,GMPORIG(10,CNT)=$G(^AUPNPROB(DA,11,FAC,11,NIFN,0)) 54 . S $P(GMPORIG(10,CNT),U,2)=FAC 55 . S GMPFLD(10,CNT)=GMPORIG(10,CNT) 56 S (GMPORIG(10,0),GMPFLD(10,0))=CNT 57 Q 58 ; 59 FLDS ; Define GMPFLD("FLD") Array for Editing 60 S (GMPFLD("FLD",2),GMPFLD("FLD",6),GMPFLD("FLD",7))="Q" 61 S GMPFLD("FLD",1)="TERM",GMPFLD("FLD","PROBLEM")=1 62 S:$D(^XUSEC("GMPL ICD CODE",DUZ)) GMPFLD("FLD",2)="ICD",GMPFLD("FLD","ICD CODE")=2 63 S GMPFLD("FLD",3)="NOTE",GMPFLD("FLD","COMMENT")=3 64 S GMPFLD("FLD",4)="ONSET",GMPFLD("FLD","DATE OF ONSET")=4 65 S GMPFLD("FLD",5)="STATUS",GMPFLD("FLD","STATUS")=5 66 S:GMPSC GMPFLD("FLD",6)="SC",GMPFLD("FLD","IS THIS PROBLEM RELATED TO A SERVICE-CONNECTED CONDITION?")=6 67 S:GMPAGTOR GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO AGENT ORANGE EXPOSURE?")=7 68 S:GMPION GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO RADIATION EXPOSURE?")=7 69 S:GMPGULF GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO ENVIRONMENTAL CONTAMINANTS EXPOSURE?")=7 70 S:GMPHNC GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO DIAGNOSED HEAD AND/OR NECK CANCER?")=7 71 S:GMPMST GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO REPORTED MILITARY SEXUAL TRAUMA?")=7 72 S GMPFLD("FLD",8)="PROV",GMPFLD("FLD","RESPONSIBLE PROVIDER")=8 73 S GMPFLD("FLD",9)="SOURCE" 74 S:$E(GMPLVIEW("VIEW"))="C" GMPFLD("FLD","CLINIC")=9 75 S:$E(GMPLVIEW("VIEW"))'="C" GMPFLD("FLD","SERVICE")=9 76 S GMPFLD("FLD",10)="RECORDED",GMPFLD("FLD","DATE RECORDED")=10 77 S GMPFLD("FLD",11)="AUTHOR",GMPFLD("FLD","RECORDING PROVIDER")=11 78 S GMPFLD("FLD",0)=11 79 Q 80 ; 81 JUMP(XFLD) ; Resolve ^- Jump Out of Field Order in Edit 82 N I,MATCH,CNT,PROMPT,DIR,X,Y 83 ; Passed in as ^XXX 84 S XFLD=$$UP^XLFSTR($P(XFLD,U,2)) 85 I (XFLD="")!(XFLD["^") S GMPQUIT=1 Q 86 I '$D(GMPLJUMP) W $C(7)," ^-jumping not allowed now!" S GMPLJUMP=0 Q 87 ; Field is Exact 88 I $G(GMPFLD("FLD",XFLD)) S GMPLJUMP=GMPFLD("FLD",XFLD) Q 89 S CNT=0,PROMPT=" " 90 F S PROMPT=$O(GMPFLD("FLD",PROMPT)) Q:PROMPT="" D 91 . Q:$E(PROMPT,1,$L(XFLD))'=XFLD 92 . S CNT=CNT+1,MATCH(CNT)=GMPFLD("FLD",PROMPT)_U_PROMPT 93 I CNT=0 W $C(7)," ??" Q 94 I CNT=1 S PROMPT=$P(MATCH(1),U,2),GMPLJUMP=+MATCH(1) W $E(PROMPT,$L(XFLD)+1,$L(PROMPT)) Q 95 ; Select which Field to Jump To. 96 F I=1:1:CNT S DIR("A",I)=I_" "_$P(MATCH(I),U,2) 97 S DIR("A")="Select 1-"_CNT_": ",DIR(0)="NAO^1:"_CNT 98 S DIR("?")="Select the field you wish to jump to, by number" 99 D ^DIR I $D(DTOUT)!($D(DUOUT))!(Y="") Q 100 S GMPLJUMP=+MATCH(+Y) 101 Q 102 ; 103 CK ; Check whether to Stop Processing 104 ; Called from Exit Action of GMPL EDIT XXX Protocols 105 S:$D(GMPQUIT) XQORPOP=1 S:'$D(GMPQUIT) GMPREBLD=1 K GMPQUIT 106 I $D(DTOUT)!($G(VALMBCK)="Q") S VALMBCK="Q" Q 107 S VALMBCK="R",VALMSG=$$MSG 108 Q -
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLENFM.m
r613 r623 1 GMPLENFM ; SLC/MKB/KER -- Problem List Enc Form utilities ; 04/15/2002 2 ;;2.0;Problem List;**3,4,7,26,35**;Aug 25, 1994;Build 26 3 ; 4 ; External References 5 ; DBIA 10082 ^ICD9( 6 ; DBIA 10006 ^DIC 7 ; DBIA 1609 CONFIG^LEXSET 8 ; 9 ACTIVE ; List of Active Problems for DFN 10 ; Sets Global Array: 11 ; ^TMP("IB",$J,"INTERFACES",DFN,"GMP PATIENT ACTIVE PROBLEMS",#) = 12 ; 13 ; Piece 1: Problem text 14 ; 2: ICD code 15 ; 3: Date of Onset 00/00/00 format 16 ; 4: SC/NSC/"" serv-conn/not sc/unknown 17 ; 5: Y/N/"" serv-conn/not sc/unknown 18 ; 6: A/I/E/H/M/C/S/"" If problem is flagged as: 19 ; A - Agent Orange 20 ; I - Ionizing Radiation 21 ; E - Environmental Contaminants 22 ; H - Head/Neck Cancer 23 ; M - Mil Sexual Trauma 24 ; C - Combat Vet 25 ; S - SHAD 26 ; - None 27 ; 7: Special Exposure Full text of piece 6 28 ; 29 N IFN,PROB,CNT,GMPL0,GMPL1,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL 30 N GMPDFN,NODE 31 Q:$G(DFN)'>0 S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0)) 32 S GMPARAM("VER")=$P(NODE,U,2),GMPARAM("REV")=$P(NODE,U,5)="R",GMPARAM("QUIET")=1 33 S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 34 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 35 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 36 . S IFN=GMPLIST(NUM) Q:IFN'>0 37 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)) 38 . S PROB=$$PROBTEXT^GMPLX(IFN),CNT=CNT+1 39 . I GMPARAM("VER"),$P(GMPL1,U,2)="T" S PROB="$"_PROB 40 . S PROB=PROB_U_$P($G(^ICD9(+$P(GMPL0,U),0)),U) 41 . S PROB=PROB_U_$$EXTDT^GMPLX($P(GMPL0,U,13)),SC=$P(GMPL1,U,10) 42 . S PROB=PROB_U_$S(+SC:"SC^Y",SC=0:"NSC^N",1:"^") 43 . S PROB=PROB_U_$$GMPL1 44 . ;S PROB=PROB_U_$S($P(GMPL1,U,11):"A^Agent Orange",$P(GMPL1,U,12):"I^Ionizing Radiation",$P(GMPL1,U,13):"E^Env. Contaminants" 45 . ;,$P(GMPL1,U,13):"H^Head/Neck Cancer",$P(GMPL1,U,16):"M^Mil Sexual Trauma",$P(GMPL1,U,17):"C^Combat Vet",$P(GMPL1,U,18):"S^SHAD",1:"^") 46 . S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"GMP PATIENT ACTIVE PROBLEMS",CNT)=PROB 47 S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"GMP PATIENT ACTIVE PROBLEMS",0)=CNT 48 Q 49 ; 50 SELECT ; Select Common Problems 51 ; Sets Global Array: 52 ; ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS") 53 ; Piece 1: Pointer to Clinical Lexicon 54 ; 2: Problem Text 55 ; 3: ICD Code (null if unknown) 56 ; 57 N X,Y,DIC,PROB D CONFIG^LEXSET("ICD","ICD") 58 K ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS") 59 S DIC("A")="Select PROBLEM: ",DIC(0)="AEQM",DIC="^LEX(757.01," 60 D ^DIC Q:+Y<0 S PROB=Y I +Y'>1 S PROB=+Y_U_X 61 S PROB=PROB_U_$G(Y(1)) 62 S ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")=PROB 63 Q 64 ; 65 DSELECT ; List of Active Problems for DFN 66 ; Sets Global Array" 67 ; ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",#) = 68 ; 69 ; Piece 1: Problem IEN 70 ; 2: Problem Text 71 ; 3: ICD code 72 ; 4: Date of Onset 00/00/00 format 73 ; 5: SC/NSC/"" serv-conn/not sc/unknown 74 ; 6: Y/N/"" serv-conn/not sc/unknown 75 ; 7: A/I/E/H/M/C/S/"" If problem is flagged as: 76 ; A - Agent Orange 77 ; I - Ionizing Radiation 78 ; E - Environmental Contaminants 79 ; H - Head/Neck Cancer 80 ; M - Mil Sexual Trauma 81 ; C - Combat Vet 82 ; S - SHAD 83 ; - None 84 ; 8: Special Exposure Full text of piece 6 85 ; 86 N IFN,PROB,CNT,GMPL0,GMPL1,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL,GMPDFN,NODE 87 Q:$G(DFN)'>0 S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0)) 88 S GMPARAM("VER")=$P(NODE,U,2),GMPARAM("REV")=$P(NODE,U,5)="R",GMPARAM("QUIET")=1 89 S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 90 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 91 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 92 . S IFN=GMPLIST(NUM) Q:IFN'>0 93 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)) 94 . S PROB=$$PROBTEXT^GMPLX(IFN),CNT=CNT+1 95 . I GMPARAM("VER"),$P(GMPL1,U,2)="T" S PROB="$"_PROB 96 . S PROB=IFN_U_PROB 97 . S PROB=PROB_U_$P($G(^ICD9(+$P(GMPL0,U),0)),U) 98 . S PROB=PROB_U_$$EXTDT^GMPLX($P(GMPL0,U,13)),SC=$P(GMPL1,U,10) 99 . S PROB=PROB_U_$S(+SC:"SC^Y",SC=0:"NSC^N",1:"^") 100 . S PROB=PROB_U_$$GMPL1 101 . ;S PROB=PROB_U_$S($P(GMPL1,U,11):"A^Agent Orange",$P(GMPL1,U,12):"I^Radiation",$P(GMPL1,U,13):"E^Contaminants",$P(GMPL1,U,13):"H^Head/Neck Cancer" 102 . ;,$P(GMPL1,U,16):"M^Mil Sexual Trauma",$P(GMPL1,U,17):"C^Combat Vet",$P(GMPL1,U,18):"S^SHAD",1:"^") 103 . S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",CNT)=PROB 104 S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=CNT 105 Q 106 ; 107 GMPL1() ;Determine Treatment Factor, if any 108 N NXTTF,TXFACTOR 109 S TXFACTOR="^" 110 F NXTTF=11,12,13,15,16,17,18 I $P(GMPL1,U,NXTTF) S TXFACTOR=$P("A^Agent Orange;I^Ionizing Radiation;E^Env. Contaminants;;H^Head/Neck Cancer;M^Mil Sexual Trauma;C^Combat Vet;S^SHAD",";",NXTTF-10) Q 111 Q TXFACTOR 1 GMPLENFM ; SLC/MKB/KER -- Problem List Enc Form utilities ; 04/15/2002 2 ;;2.0;Problem List;**3,4,7,26**;Aug 25, 1994;Build 1 3 ; 4 ; External References 5 ; DBIA 10082 ^ICD9( 6 ; DBIA 10006 ^DIC 7 ; DBIA 1609 CONFIG^LEXSET 8 ; 9 ACTIVE ; List of Active Problems for DFN 10 ; Sets Global Array: 11 ; ^TMP("IB",$J,"INTERFACES",DFN,"GMP PATIENT ACTIVE PROBLEMS",#) = 12 ; 13 ; Piece 1: Problem text 14 ; 2: ICD code 15 ; 3: Date of Onset 00/00/00 format 16 ; 4: SC/NSC/"" serv-conn/not sc/unknown 17 ; 5: Y/N/"" serv-conn/not sc/unknown 18 ; 6: A/R/C/H/M/"" If problem is flagged as: 19 ; A - Agent Orange 20 ; R - Radiation 21 ; C - Contaminants 22 ; H - Head/Neck Cancer 23 ; M - Mil Sexual Trauma 24 ; - None 25 ; 7: Special Exposure Full text of piece 6 26 ; 27 N IFN,PROB,CNT,GMPL0,GMPL1,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL 28 N GMPDFN,NODE 29 Q:$G(DFN)'>0 S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0)) 30 S GMPARAM("VER")=$P(NODE,U,2),GMPARAM("REV")=$P(NODE,U,5)="R",GMPARAM("QUIET")=1 31 S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 32 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 33 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 34 . S IFN=GMPLIST(NUM) Q:IFN'>0 35 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)) 36 . S PROB=$$PROBTEXT^GMPLX(IFN),CNT=CNT+1 37 . I GMPARAM("VER"),$P(GMPL1,U,2)="T" S PROB="$"_PROB 38 . S PROB=PROB_U_$P($G(^ICD9(+$P(GMPL0,U),0)),U) 39 . S PROB=PROB_U_$$EXTDT^GMPLX($P(GMPL0,U,13)),SC=$P(GMPL1,U,10) 40 . S PROB=PROB_U_$S(+SC:"SC^Y",SC=0:"NSC^N",1:"^") 41 . S PROB=PROB_U_$S($P(GMPL1,U,11):"A^Agent Orange",$P(GMPL1,U,12):"R^Radiation",$P(GMPL1,U,13):"C^Contaminants",$P(GMPL1,U,13):"H^Head/Neck Cancer",$P(GMPL1,U,16):"M^Mil Sexual Trauma",1:"^") 42 . S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"GMP PATIENT ACTIVE PROBLEMS",CNT)=PROB 43 S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"GMP PATIENT ACTIVE PROBLEMS",0)=CNT 44 Q 45 ; 46 SELECT ; Select Common Problems 47 ; Sets Global Array: 48 ; ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS") 49 ; Piece 1: Pointer to Clinical Lexicon 50 ; 2: Problem Text 51 ; 3: ICD Code (null if unknown) 52 ; 53 N X,Y,DIC,PROB D CONFIG^LEXSET("ICD","ICD") 54 K ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS") 55 S DIC("A")="Select PROBLEM: ",DIC(0)="AEQM",DIC="^LEX(757.01," 56 D ^DIC Q:+Y<0 S PROB=Y I +Y'>1 S PROB=+Y_U_X 57 S PROB=PROB_U_$G(Y(1)) 58 S ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")=PROB 59 Q 60 ; 61 DSELECT ; List of Active Problems for DFN 62 ; Sets Global Array" 63 ; ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",#) = 64 ; 65 ; Piece 1: Problem IEN 66 ; 2: Problem Text 67 ; 3: ICD code 68 ; 4: Date of Onset 00/00/00 format 69 ; 5: SC/NSC/"" serv-conn/not sc/unknown 70 ; 6: Y/N/"" serv-conn/not sc/unknown 71 ; 7: A/R/C/H/M/"" If problem is flagged as: 72 ; A - Agent Orange 73 ; R - Radiation 74 ; C - Contaminants 75 ; H - Head/Neck Cancer 76 ; M - Mil Sexual Trauma 77 ; - None 78 ; 8: Special Exposure Full text of piece 6 79 ; 80 N IFN,PROB,CNT,GMPL0,GMPL1,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL,GMPDFN,NODE 81 Q:$G(DFN)'>0 S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0)) 82 S GMPARAM("VER")=$P(NODE,U,2),GMPARAM("REV")=$P(NODE,U,5)="R",GMPARAM("QUIET")=1 83 S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 84 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 85 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 86 . S IFN=GMPLIST(NUM) Q:IFN'>0 87 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)) 88 . S PROB=$$PROBTEXT^GMPLX(IFN),CNT=CNT+1 89 . I GMPARAM("VER"),$P(GMPL1,U,2)="T" S PROB="$"_PROB 90 . S PROB=IFN_U_PROB 91 . S PROB=PROB_U_$P($G(^ICD9(+$P(GMPL0,U),0)),U) 92 . S PROB=PROB_U_$$EXTDT^GMPLX($P(GMPL0,U,13)),SC=$P(GMPL1,U,10) 93 . S PROB=PROB_U_$S(+SC:"SC^Y",SC=0:"NSC^N",1:"^") 94 . S PROB=PROB_U_$S($P(GMPL1,U,11):"A^Agent Orange",$P(GMPL1,U,12):"R^Radiation",$P(GMPL1,U,13):"C^Contaminants",$P(GMPL1,U,13):"H^Head/Neck Cancer",$P(GMPL1,U,16):"M^Mil Sexual Trauma",1:"^") 95 . S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",CNT)=PROB 96 S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=CNT 97 Q -
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLHIST.m
r613 r623 1 GMPLHIST 2 ;;2.0;Problem List;**7,26,,31,35**;Aug 25, 1994;Build 26 3 4 5 6 7 DT 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 FLDNAME(NUM) 36 37 38 39 ALP(X) 40 41 42 43 44 S X(1.14)="PRIORITY",X(1.15)="HEAD/NECK CANCER",X(1.16)="MIL SEXUAL TRAUMA",X(1.17)="COMBAT VET",X(1.18)="SHAD",X(1101)="NOTE"45 46 NUM(X) 47 48 49 F FN=1.01:.01:1.18S X(+FN)=+FN50 51 1 GMPLHIST ; SLC/MKB/KER -- Problem List Historical data ; 04/15/2002 2 ;;2.0;Problem List;**7,26,31**;Aug 25, 1994;Build 1 3 ; 4 ; External References 5 ; DBIA 10060 ^VA(200 6 ; 7 DT ; Add historical data (audit trail) to DT list 8 ; Called from ^GMPLDISP, requires AIFN and adds to GMPDT() 9 N NODE,DATE,FLD,PROV,OLD,NEW,ROOT,CHNGE,REASON 10 S NODE=$G(^GMPL(125.8,AIFN,0)) Q:NODE="" 11 S DATE=$$EXTDT^GMPLX($P(NODE,U,3)),FLD=+$P(NODE,U,2),PROV=+$P(NODE,U,8) 12 S:'PROV PROV=$P(NODE,U,4) 13 S FLD=FLD_U_$$FLDNAME(+FLD),PROV=$P($G(^VA(200,PROV,0)),U) 14 S OLD=$P(NODE,U,5),NEW=$P(NODE,U,6),LCNT=LCNT+1 15 I +FLD=1101 D Q 16 . S REASON=" removed by " 17 . S:OLD="C" REASON=" changed by " 18 . S NODE=$G(^GMPL(125.8,AIFN,1)) 19 . S GMPDT(LCNT,0)=$J(DATE,10)_": NOTE "_$$EXTDT^GMPLX($P(NODE,U,5))_REASON_PROV_":" 20 . S LCNT=LCNT+1,GMPDT(LCNT,0)=" "_$P(NODE,U,3) 21 I +FLD=1.02 D Q 22 . S CHNGE=$S(NEW="H":"removed",OLD="T":"verified",1:"placed back on list") 23 . S GMPDT(LCNT,0)=$J(DATE,10)_": PROBLEM "_CHNGE_" by "_PROV 24 S GMPDT(LCNT,0)=$J(DATE,10)_": "_$P(FLD,U,2)_" changed by "_PROV,LCNT=LCNT+1 25 I +FLD=.12 S GMPDT(LCNT,0)=$J("from ",17)_$S(OLD="A":"ACTIVE",OLD="I":"INACTIVE",1:"UNKNOWN")_" to "_$S(NEW="A":"ACTIVE",NEW="I":"INACTIVE",1:"UNKNOWN") Q 26 I (+FLD=.13)!(+FLD=1.07) S GMPDT(LCNT,0)=$J("from ",17)_$$EXTDT^GMPLX(OLD)_" to "_$$EXTDT^GMPLX(NEW) Q 27 I +FLD=1.14 S GMPDT(LCNT,0)=$J("from ",17)_$S(OLD="A":"ACUTE",OLD="C":"CHRONIC",1:"UNSPECIFIED")_" to "_$S(NEW="A":"ACUTE",NEW="C":"CHRONIC",1:"UNSPECIFIED") Q 28 I +FLD>1.09 S GMPDT(LCNT,0)=$J("from ",17)_$S(+OLD:"YES",OLD=0:"NO",1:"UNKNOWN")_" to "_$S(+NEW:"YES",NEW=0:"NO",1:"UNKNOWN") Q 29 I "^.01^.05^1.01^1.04^1.05^1.06^1.08^"[(U_+FLD_U) D 30 . S ROOT=$S(+FLD=.01:"ICD9(",+FLD=.05:"AUTNPOV(",+FLD=1.01:"LEX(757.01,",(+FLD=1.04)!(+FLD=1.05):"VA(200,",+FLD=1.06:"DIC(49,",+FLD=1.08:"SC(",1:"") Q:ROOT="" 31 . S GMPDT(LCNT,0)=$J("from ",17)_$S(OLD:$P(@(U_ROOT_OLD_",0)"),U),1:"UNSPECIFIED") 32 . S LCNT=LCNT+1,GMPDT(LCNT,0)=$J("to ",17)_$S(NEW:$P(@(U_ROOT_NEW_",0)"),U),1:"UNSPECIFIED") 33 Q 34 ; 35 FLDNAME(NUM) ; Returns Field Name for Display 36 N NAME,NM1,NM2,I,J S J=0,NAME="" D NUM(.NM1),ALP(.NM2) S:+($G(NM1(+NUM)))=+NUM J=+NUM 37 S:$L($G(NM2(+J))) NAME=$G(NM2(+J)) 38 Q NAME 39 ALP(X) ; Alpha Field Names 40 S X(.01)="DIAGNOSIS",X(.02)="PATIENT NAME",X(.03)="DATE LAST MODIFIED",X(.04)="CLASS",X(.05)="PROVIDER NARRATIVE" 41 S X(.06)="FACILITY",X(.07)="NUMBER",X(.08)="DATE ENTERED",X(.12)="STATUS",X(.13)="DATE OF ONSET",X(1.01)="PROBLEM",X(1.02)="CONDITION" 42 S X(1.03)="ENTERED BY",X(1.04)="RECORDING PROVIDER",X(1.05)="RESPONSIBLE PROVIDER",X(1.06)="SERVICE",X(1.07)="DATE RESOLVED" 43 S X(1.08)="CLINIC",X(1.09)="DATE RECORDED",X(1.1)="SERVICE CONNECTED",X(1.11)="AGENT ORANGE EXP",X(1.12)="RADIATION EXP",X(1.13)="ENV CONTAMINANTS EXP" 44 S X(1.14)="PRIORITY",X(1.15)="HEAD/NECK CANCER",X(1.16)="MIL SEXUAL TRAUMA",X(1101)="NOTE" 45 Q 46 NUM(X) ; Numeric Field Designations 47 N FN F FN=.01:.01:.08 S X(+FN)=+FN 48 F FN=.12:.01:.13 S X(+FN)=+FN 49 F FN=1.01:.01:1.16 S X(+FN)=+FN 50 S X(1101)=1101 51 Q -
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLHS.m
r613 r623 1 GMPLHS ; SLC/MKB/KER - Extract Prob List Health Summary ; 04/15/2002 2 ;;2.0;Problem List;**22,26,35**;Aug 25, 1994;Build 26 3 ; 4 ; External References 5 ; DBIA 3106 ^DIC(49 6 ; DBIA 10060 ^VA(200 7 ; DBIA 10015 EN^DIQ1 8 ; 9 GETLIST(GMPDFN,STATUS) ; Define List 10 N GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL K ^TMP("GMPLHS",$J) Q:+GMPDFN'>0 11 S GMPARAM("QUIET")=1,GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R" 12 S GMPLVIEW("ACT")=STATUS,GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 13 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 14 BUILD ; Build list for selected patient 15 ; Sets Global Array: 16 ; ^TMP("GMPLHS",$J,STATUS,0) 17 ; 18 ; Piece 1: GMPCNT # of entries extracted 19 ; 2: GMPTOTAL # of entries that exist 20 N IFN,GMPCNT,NUM S (NUM,GMPCNT)=0 F S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 21 . S IFN=+GMPLIST(NUM) Q:IFN'>0 D GETPROB(IFN) 22 I $G(GMPCNT)'>0 K ^TMP("GMPLHS",$J) Q 23 S ^TMP("GMPLHS",$J,STATUS,0)=GMPCNT_U_GMPTOTAL 24 Q 25 GETPROB(IFN) ; Get problem data and set it to ^TMP array 26 ; Sets Global Arrays: 27 ; ^TMP("GMPLHS",$J,CNT,0) 28 ; Piece 1: Pointer to ICD9 file #80 29 ; 2: Internal Date Last Modified 30 ; 3: Facility Name 31 ; 4: Internal Date Entered 32 ; 5: Internal Status (A/I/"") 33 ; 6: Internal Date of Onset 34 ; 7: Responsible Provider Name 35 ; 8: Service Name 36 ; 9: Service Abbreviation 37 ; 10: Internal Date Resolved 38 ; 11: Clinic Name 39 ; 12: Internal Date Recorded 40 ; 13: Problem Term (from Lexicon) 41 ; 14: Exposure String (AO/IR/EC/HNC/MST/CV/SHD) 42 ; 43 ; ^TMP("GMPLHS",$J,CNT,"N") 44 ; Piece 1: Provider Narrative 45 ; 46 ; ^TMP("GMPLHS",$J,CNT,"IEN") 47 ; Piece 1: Pointer to Problem file 9000011 48 ; 49 N DIC,DIQ,DR,DA,REC,DIAG,LASTMDT,NARR,SITE,ENTDT,STAT,ONSETDT,RPROV 50 N SERV,SERVABB,RESDT,CLIN,RECDT,LEXI,LEX,PG,AO,EXP,HNC,MST,CV,SHD,IR,SCS 51 S DIC=9000011,DA=IFN,DIQ="REC(",DIQ(0)="IE" 52 S DR=".01;.03;.05;.06;.08;.12;.13;1.01;1.05;1.06;1.07;1.08;1.09;1.11;1.12;1.13;1.15;1.16;1.17;1.18" 53 D EN^DIQ1 54 S DIAG=REC(9000011,DA,.01,"I"),LASTMDT=REC(9000011,DA,.03,"I") 55 S NARR=REC(9000011,DA,.05,"E"),SITE=REC(9000011,DA,.06,"E") 56 S ENTDT=REC(9000011,DA,.08,"I"),STAT=REC(9000011,DA,.12,"I") 57 S ONSETDT=REC(9000011,DA,.13,"I") 58 S LEXI=REC(9000011,DA,1.01,"I") 59 S LEX=REC(9000011,DA,1.01,"E") 60 S RPROV=REC(9000011,DA,1.05,"E") 61 S SERV=REC(9000011,DA,1.06,"E") 62 S SERVABB=$$SERV(REC(9000011,DA,1.06,"I"),SERV) 63 S RESDT=REC(9000011,DA,1.07,"I") 64 S CLIN=REC(9000011,DA,1.08,"E") 65 S RECDT=REC(9000011,DA,1.09,"I") 66 S AO=+REC(9000011,DA,1.11,"I") 67 S IR=+REC(9000011,DA,1.12,"I") 68 S PG=+REC(9000011,DA,1.13,"I") 69 S HNC=+REC(9000011,DA,1.15,"I") 70 S MST=+REC(9000011,DA,1.16,"I") 71 S CV=+REC(9000011,DA,1.17,"I") 72 S SHD=+REC(9000011,DA,1.18,"I") 73 K SCS D SCS^GMPLX1(DA,.SCS) S EXP=$G(SCS(1)) 74 S GMPCNT=GMPCNT+1,^TMP("GMPLHS",$J,GMPCNT,0)=DIAG_U_LASTMDT_U_SITE_U_ENTDT_U_STAT_U_ONSETDT_U_RPROV_U_SERV_U_SERVABB_U_RESDT_U_CLIN_U_RECDT_U_LEX_U_EXP 75 S ^TMP("GMPLHS",$J,GMPCNT,"N")=NARR,^TMP("GMPLHS",$J,GMPCNT,"IEN")=IFN 76 S:+LEXI>0 ^TMP("GMPLHS",$J,GMPCNT,"L")=LEXI_"^"_LEX 77 D GETCOMM(IFN,GMPCNT) 78 Q 79 GETCOMM(IFN,CNT) ; Get Active Comments for a Note 80 ; Sets Global Array: 81 ; ^TMP("GMPLHS",$J,CNT,"C",LOCATION,NOTE NMBR,0) 82 ; 83 ; Piece 1: Note Narrative 84 ; 2: Internal Date Note Added 85 ; 3; Name of Note's Author 86 ; 87 N IFN2,IFN3,LOC,NODE S LOC=0 Q:$D(^AUPNPROB(IFN,11))'>0 S IFN2=0 88 F S IFN2=$O(^AUPNPROB(IFN,11,IFN2)) Q:IFN2'>0 D 89 . Q:$D(^AUPNPROB(IFN,11,IFN2,11))'>0 90 . S LOC=+$G(^AUPNPROB(IFN,11,IFN2,0)),IFN3=0 91 . F S IFN3=$O(^AUPNPROB(IFN,11,IFN2,11,IFN3)) Q:IFN3'>0 D 92 . . S NODE=$G(^AUPNPROB(IFN,11,IFN2,11,IFN3,0)) Q:$P(NODE,U,4)']"" 93 . . S ^TMP("GMPLHS",$J,CNT,"C",LOC,$P(NODE,U),0)=$P(NODE,U,3)_U_$P(NODE,U,5)_U_$P($G(^VA(200,+$P(NODE,U,6),0)),U) 94 Q 95 SERV(X,SERV) ; Returns Service Name Abbreviation 96 N ABBREV S ABBREV=$P($G(^DIC(49,+X,0)),U,2) S:ABBREV="" ABBREV=$E($G(SERV),1,5) 97 Q ABBREV 1 GMPLHS ; SLC/MKB/KER - Extract Prob List Health Summary ; 04/15/2002 2 ;;2.0;Problem List;**22,26**;Aug 25, 1994 3 ; 4 ; External References 5 ; DBIA 3106 ^DIC(49 6 ; DBIA 10060 ^VA(200 7 ; DBIA 10015 EN^DIQ1 8 ; 9 GETLIST(GMPDFN,STATUS) ; Define List 10 N GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL K ^TMP("GMPLHS",$J) Q:+GMPDFN'>0 11 S GMPARAM("QUIET")=1,GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R" 12 S GMPLVIEW("ACT")=STATUS,GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 13 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 14 BUILD ; Build list for selected patient 15 ; Sets Global Array: 16 ; ^TMP("GMPLHS",$J,STATUS,0) 17 ; 18 ; Piece 1: GMPCNT # of entries extracted 19 ; 2: GMPTOTAL # of entries that exist 20 N IFN,GMPCNT,NUM S (NUM,GMPCNT)=0 F S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 21 . S IFN=+GMPLIST(NUM) Q:IFN'>0 D GETPROB(IFN) 22 I $G(GMPCNT)'>0 K ^TMP("GMPLHS",$J) Q 23 S ^TMP("GMPLHS",$J,STATUS,0)=GMPCNT_U_GMPTOTAL 24 Q 25 GETPROB(IFN) ; Get problem data and set it to ^TMP array 26 ; Sets Global Arrays: 27 ; ^TMP("GMPLHS",$J,CNT,0) 28 ; Piece 1: Pointer to ICD9 file #80 29 ; 2: Internal Date Last Modified 30 ; 3: Facility Name 31 ; 4: Internal Date Entered 32 ; 5: Internal Status (A/I/"") 33 ; 6: Internal Date of Onset 34 ; 7: Responsible Provider Name 35 ; 8: Service Name 36 ; 9: Service Abbreviation 37 ; 10: Internal Date Resolved 38 ; 11: Clinic Name 39 ; 12: Internal Date Recorded 40 ; 13: Problem Term (from Lexicon) 41 ; 14: Exposure String (AO/IR/EC/HNC/MST) 42 ; 43 ; ^TMP("GMPLHS",$J,CNT,"N") 44 ; Piece 1: Provider Narrative 45 ; 46 ; ^TMP("GMPLHS",$J,CNT,"IEN") 47 ; Piece 1: Pointer to Problem file 9000011 48 ; 49 N DIC,DIQ,DR,DA,REC,DIAG,LASTMDT,NARR,SITE,ENTDT,STAT,ONSETDT,RPROV 50 N SERV,SERVABB,RESDT,CLIN,RECDT,LEXI,LEX,PG,AO,EXP,HNC,MST,IR,SCS 51 S DIC=9000011,DA=IFN,DIQ="REC(",DIQ(0)="IE" 52 S DR=".01;.03;.05;.06;.08;.12;.13;1.01;1.05;1.06;1.07;1.08;1.09;1.11;1.12;1.13;1.15;1.16" 53 D EN^DIQ1 54 S DIAG=REC(9000011,DA,.01,"I"),LASTMDT=REC(9000011,DA,.03,"I") 55 S NARR=REC(9000011,DA,.05,"E"),SITE=REC(9000011,DA,.06,"E") 56 S ENTDT=REC(9000011,DA,.08,"I"),STAT=REC(9000011,DA,.12,"I") 57 S ONSETDT=REC(9000011,DA,.13,"I") 58 S LEXI=REC(9000011,DA,1.01,"I") 59 S LEX=REC(9000011,DA,1.01,"E") 60 S RPROV=REC(9000011,DA,1.05,"E") 61 S SERV=REC(9000011,DA,1.06,"E") 62 S SERVABB=$$SERV(REC(9000011,DA,1.06,"I"),SERV) 63 S RESDT=REC(9000011,DA,1.07,"I") 64 S CLIN=REC(9000011,DA,1.08,"E") 65 S RECDT=REC(9000011,DA,1.09,"I") 66 S AO=+REC(9000011,DA,1.11,"I") 67 S IR=+REC(9000011,DA,1.12,"I") 68 S PG=+REC(9000011,DA,1.13,"I") 69 S HNC=+REC(9000011,DA,1.15,"I") 70 S MST=+REC(9000011,DA,1.16,"I") 71 K SCS D SCS^GMPLX1(DA,.SCS) S EXP=$G(SCS(1)) 72 S GMPCNT=GMPCNT+1,^TMP("GMPLHS",$J,GMPCNT,0)=DIAG_U_LASTMDT_U_SITE_U_ENTDT_U_STAT_U_ONSETDT_U_RPROV_U_SERV_U_SERVABB_U_RESDT_U_CLIN_U_RECDT_U_LEX_U_EXP 73 S ^TMP("GMPLHS",$J,GMPCNT,"N")=NARR,^TMP("GMPLHS",$J,GMPCNT,"IEN")=IFN 74 S:+LEXI>0 ^TMP("GMPLHS",$J,GMPCNT,"L")=LEXI_"^"_LEX 75 D GETCOMM(IFN,GMPCNT) 76 Q 77 GETCOMM(IFN,CNT) ; Get Active Comments for a Note 78 ; Sets Global Array: 79 ; ^TMP("GMPLHS",$J,CNT,"C",LOCATION,NOTE NMBR,0) 80 ; 81 ; Piece 1: Note Narrative 82 ; 2: Internal Date Note Added 83 ; 3; Name of Note's Author 84 ; 85 N IFN2,IFN3,LOC,NODE S LOC=0 Q:$D(^AUPNPROB(IFN,11))'>0 S IFN2=0 86 F S IFN2=$O(^AUPNPROB(IFN,11,IFN2)) Q:IFN2'>0 D 87 . Q:$D(^AUPNPROB(IFN,11,IFN2,11))'>0 88 . S LOC=+$G(^AUPNPROB(IFN,11,IFN2,0)),IFN3=0 89 . F S IFN3=$O(^AUPNPROB(IFN,11,IFN2,11,IFN3)) Q:IFN3'>0 D 90 . . S NODE=$G(^AUPNPROB(IFN,11,IFN2,11,IFN3,0)) Q:$P(NODE,U,4)']"" 91 . . S ^TMP("GMPLHS",$J,CNT,"C",LOC,$P(NODE,U),0)=$P(NODE,U,3)_U_$P(NODE,U,5)_U_$P($G(^VA(200,+$P(NODE,U,6),0)),U) 92 Q 93 SERV(X,SERV) ; Returns Service Name Abbreviation 94 N ABBREV S ABBREV=$P($G(^DIC(49,+X,0)),U,2) S:ABBREV="" ABBREV=$E($G(SERV),1,5) 95 Q ABBREV -
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLSAVE.m
r613 r623 1 GMPLSAVE ; SLC/MKB/KER -- Save Problem List data ; 03/13/2008 2 ;;2.0;Problem List;**26,31,35**;Aug 25, 1994;Build 26 3 ; 4 ; External References 5 ; DBIA 10018 ^DIE 6 ; DBIA 10013 ^DIK 7 ; DBIA 10013 IX1^DIK 8 ; DBIA 10103 $$HTFM^XLFDT 9 ; 10 EN ; Save Changes made to Existing Problem 11 N FLD,NOW,CHNGE,I,NIFN,TEXT,OLDTEXT,FAC,NODE,AUDITED,DR,DA,DIE,DIK 12 S:'GMPORIG(.01) GMPORIG(.01)=$$NOS^GMPLX 13 S:'GMPFLD(.01) GMPFLD(.01)=$$NOS^GMPLX 14 S:$D(GMPFLD(.01)) GMPFLD(.01)=+GMPFLD(.01) 15 S:$P(+GMPFLD(.01),U)=-1 GMPFLD(.01)=$$NOS^GMPLX ;chk for error from ICD 16 S:'GMPORIG(1.01) GMPORIG(1.01)="1^Unresolved" 17 S:'GMPFLD(1.01) GMPFLD(1.01)="1^Unresolved" 18 S:'GMPFLD(.05) I=$P(GMPFLD(.05),U,2),GMPFLD(.05)=$$PROVNARR^GMPLX(I,+GMPFLD(1.01)) 19 S NOW=$$HTFM^XLFDT($H),AUDITED=0 20 S DR="1.02////"_$S('$D(GMPLUSER):"T",1:GMPFLD(1.02)) 21 I GMPORIG(1.02)="T",GMPFLD(1.02)="P" D 22 . S CHNGE=GMPIFN_"^1.02^"_NOW_U_DUZ_"^T^P^Verified^"_DUZ 23 . D AUDIT^GMPLX(CHNGE,"") 24 I $P($G(GMPORIG(.12)),U)="I",$P(GMPFLD(.12),U)="A" D REACTV S AUDITED=1 25 I +$G(GMPORIG(1.01))'=(+GMPFLD(1.01)) D REFORM S AUDITED=1 26 S GMPFLD(.01)=+GMPFLD(.01) ;to remove text left by ?? lex (~) 27 F FLD=.01,.05,.12,.13,1.01,1.05,1.06,1.07,1.08,1.09,1.1,1.11,1.12,1.13,1.14,1.15,1.16,1.17,1.18 D 28 . Q:'$D(GMPFLD(FLD)) Q:$P($G(GMPORIG(FLD)),U)=$P($G(GMPFLD(FLD)),U) 29 . S DR=DR_";"_FLD_"////"_$S($P(GMPFLD(FLD),U)'="":$P(GMPFLD(FLD),U),1:"@") 30 . Q:AUDITED S CHNGE=GMPIFN_U_FLD_U_NOW_U_DUZ_U_$P(GMPORIG(FLD),U)_U_$P(GMPFLD(FLD),U)_"^^"_+$G(GMPROV) 31 . D AUDIT^GMPLX(CHNGE,"") 32 S DA=GMPIFN,DIE="^AUPNPROB(" D ^DIE S GMPSAVED=1 33 NOTES ; Save Changes to Notes 34 F I=0:0 S I=$O(GMPORIG(10,I)) Q:I'>0 I GMPORIG(10,I)'=GMPFLD(10,I) D 35 . S NIFN=+GMPFLD(10,I),FAC=$P(GMPFLD(10,I),U,2),TEXT=$P(GMPFLD(10,I),U,3),OLDTEXT=$P(GMPORIG(10,I),U,3) 36 . S NODE=$G(^AUPNPROB(GMPIFN,11,FAC,11,NIFN,0)) 37 . I TEXT'="" S $P(^AUPNPROB(GMPIFN,11,FAC,11,NIFN,0),U,3)=TEXT D 38 .. I TEXT=OLDTEXT Q 39 .. S CHNGE=GMPIFN_"^1101^"_NOW_U_DUZ_"^C^^Note Modified^"_+$G(GMPROV) 40 . I TEXT=OLDTEXT Q 41 . I TEXT="" S CHNGE=GMPIFN_"^1101^"_NOW_U_DUZ_"^A^^Deleted Note^"_+$G(GMPROV) 42 . D AUDIT^GMPLX(CHNGE,NODE) 43 . I TEXT="" D 44 .. S DIK="^AUPNPROB("_GMPIFN_",11,"_FAC_",11," 45 .. S DA(2)=GMPIFN,DA(1)=FAC,DA=NIFN D ^DIK 46 I $D(GMPFLD(10,"NEW"))>9 D NEWNOTE 47 EXIT ; Quit Saving Changes 48 D:$G(GMPSAVED) DTMOD^GMPLX(GMPIFN) 49 Q 50 ; 51 REFORM ; Audit Entry that has been Reformulated 52 S CHNGE=GMPIFN_"^1.01^"_NOW_U_DUZ_U_+GMPORIG(1.01)_U_+GMPFLD(1.01)_"^Reformulated^"_+$G(GMPROV) 53 S NODE=$G(^AUPNPROB(GMPIFN,0))_U_$G(^AUPNPROB(GMPIFN,1)) 54 D AUDIT^GMPLX(CHNGE,NODE) 55 Q 56 ; 57 REACTV ; Audit Entry that has been Reactivated 58 S CHNGE=GMPIFN_"^.12^"_NOW_U_DUZ_"^I^A^Reactivated^"_+$G(GMPROV) 59 S NODE=$G(^AUPNPROB(GMPIFN,0))_U_$G(^AUPNPROB(GMPIFN,1)) 60 D AUDIT^GMPLX(CHNGE,NODE) 61 Q 62 ; 63 NEW ; Save Collected Values in new Problem Entry 64 ; Output DA (left defined) 65 N DATA,APCDLOOK,APCDALVR,NUM,I,DIK,GMPIFN,X 66 S:'GMPFLD(.01) GMPFLD(.01)=$$NOS^GMPLX 67 S:$P(+GMPFLD(.01),U)=-1 GMPFLD(.01)=$$NOS^GMPLX ;chk for error from ICD 68 S GMPFLD(.01)=+GMPFLD(.01) ;to remove text left by ?? lex (~) 69 S:'GMPFLD(1.01) GMPFLD(1.01)="1^Unresolved" 70 S:'GMPFLD(.05) X=$P(GMPFLD(.05),U,2),GMPFLD(.05)=$$PROVNARR^GMPLX(X,+GMPFLD(1.01)) 71 S DA=$$NEWPROB(+GMPFLD(.01),+GMPDFN) Q:DA'>0 72 S NUM=$$NEXTNMBR(+GMPDFN,+GMPVAMC),GMPSAVED=1 S:'NUM NUM="" 73 ; Set Node 0 74 S DATA=^AUPNPROB(DA,0)_U_DT_"^^"_$P(GMPFLD(.05),U)_U_+GMPVAMC_U_+NUM_U_DT_"^^^^"_$P(GMPFLD(.12),U)_U_$P(GMPFLD(.13),U) 75 S ^AUPNPROB(DA,0)=DATA 76 ; Set Node 1 77 S DATA=$P(GMPFLD(1.01),U) F I=1.02:.01:1.18 S DATA=DATA_U_$P($G(GMPFLD(+I)),U) 78 S ^AUPNPROB(DA,1)=DATA 79 ; Set X-Refs 80 S DIK="^AUPNPROB(",(APCDLOOK,APCDALVR)=1 D IX1^DIK 81 I $D(GMPFLD(10,"NEW"))>9 S GMPIFN=DA D NEWNOTE 82 Q 83 ; 84 NEWPROB(ICD,DFN) ; Creates New Problem Entry in file #9000011 85 N I,HDR,LAST,TOTAL,DA 86 L +^AUPNPROB(0):1 I '$T D Q -1 87 . W !!,"Someone else is currently editing this file." 88 . W !,"Please try again later.",! 89 S HDR=$G(^AUPNPROB(0)) Q:HDR="" -1 90 S LAST=$P(HDR,U,3),TOTAL=$P(HDR,U,4) 91 F I=(LAST+1):1 Q:'$D(^AUPNPROB(I,0)) 92 S DA=I,^AUPNPROB(DA,0)=ICD_U_DFN 93 S ^AUPNPROB("B",ICD,DA)="",^AUPNPROB("AC",DFN,DA)="" 94 S $P(^AUPNPROB(0),U,3,4)=DA_U_(TOTAL+1) L -^AUPNPROB(0) 95 Q DA 96 ; 97 NEWNOTE ; Creates New Note Entries for Problem 98 ; Requires GMPIFN Pointer to Problem 99 ; GMPROV Current Provider 100 ; GMPVAMC Facility 101 N HDR,LAST,TOTAL,I,FAC,NIFN 102 L +^AUPNPROB(GMPIFN,11):1 I '$T Q 103 S FAC=+$O(^AUPNPROB(GMPIFN,11,"B",GMPVAMC,0)) I 'FAC D 104 . S:'$D(^AUPNPROB(GMPIFN,11,0)) ^(0)="^9000011.11PA^^" 105 . S HDR=^AUPNPROB(GMPIFN,11,0),LAST=$P(HDR,U,3),TOTAL=$P(HDR,U,4) 106 . F I=(LAST+1):1 Q:'$D(^AUPNPROB(GMPIFN,11,I,0)) 107 . S ^AUPNPROB(GMPIFN,11,I,0)=GMPVAMC,^AUPNPROB(GMPIFN,11,"B",GMPVAMC,I)="" 108 . S FAC=I,$P(^AUPNPROB(GMPIFN,11,0),U,3,4)=FAC_U_(TOTAL+1) 109 I FAC'>0 G NNQ 110 NN1 ; Get New Note 111 S:'$D(^AUPNPROB(GMPIFN,11,FAC,11,0)) ^(0)="^9000011.1111IA^^" 112 S HDR=^AUPNPROB(GMPIFN,11,FAC,11,0),LAST=$P(HDR,U,3),TOTAL=$P(HDR,U,4) 113 F I=(LAST+1):1 Q:'$D(^AUPNPROB(GMPIFN,11,FAC,11,I,0)) 114 S NIFN=I 115 F I=0:0 S I=$O(GMPFLD(10,"NEW",I)) Q:I'>0 D 116 . S ^AUPNPROB(GMPIFN,11,FAC,11,NIFN,0)=NIFN_"^^"_GMPFLD(10,"NEW",I)_"^A^"_DT_U_+$G(GMPROV) 117 . S ^AUPNPROB(GMPIFN,11,FAC,11,"B",NIFN,NIFN)="" 118 . S TOTAL=TOTAL+1,LAST=NIFN,NIFN=NIFN+1 119 S $P(^AUPNPROB(GMPIFN,11,FAC,11,0),U,3,4)=LAST_U_TOTAL 120 NNQ ; Quit Getting New Notes 121 L -^AUPNPROB(GMPIFN,11) 122 Q 123 ; 124 NEXTNMBR(DFN,VAMC) ; Returns Next Available Problem Number 125 N I,J,NUM S NUM=1,I="" I '$D(^AUPNPROB("AA",DFN,VAMC)) Q NUM 126 F S I=$O(^AUPNPROB("AA",DFN,VAMC,I)) Q:I="" S J=$E(I,2,999),NUM=+J 127 S NUM=NUM+1 128 Q NUM 1 GMPLSAVE ; SLC/MKB/KER -- Save Problem List data ; 04/15/2002 2 ;;2.0;Problem List;**26,31**;Aug 25, 1994 3 ; 4 ; External References 5 ; DBIA 10018 ^DIE 6 ; DBIA 10013 ^DIK 7 ; DBIA 10013 IX1^DIK 8 ; DBIA 10103 $$HTFM^XLFDT 9 ; 10 EN ; Save Changes made to Existing Problem 11 N FLD,NOW,CHNGE,I,NIFN,TEXT,OLDTEXT,FAC,NODE,AUDITED,DR,DA,DIE,DIK 12 S:'GMPORIG(.01) GMPORIG(.01)=$$NOS^GMPLX 13 S:'GMPFLD(.01) GMPFLD(.01)=$$NOS^GMPLX 14 S:$P(+GMPFLD(.01),U)=-1 GMPFLD(.01)=$$NOS^GMPLX ;chk for error from ICD 15 S:'GMPORIG(1.01) GMPORIG(1.01)="1^Unresolved" 16 S:'GMPFLD(1.01) GMPFLD(1.01)="1^Unresolved" 17 S:'GMPFLD(.05) I=$P(GMPFLD(.05),U,2),GMPFLD(.05)=$$PROVNARR^GMPLX(I,+GMPFLD(1.01)) 18 S NOW=$$HTFM^XLFDT($H),AUDITED=0 19 S DR="1.02////"_$S('$D(GMPLUSER):"T",1:GMPFLD(1.02)) 20 I GMPORIG(1.02)="T",GMPFLD(1.02)="P" D 21 . S CHNGE=GMPIFN_"^1.02^"_NOW_U_DUZ_"^T^P^Verified^"_DUZ 22 . D AUDIT^GMPLX(CHNGE,"") 23 I $P($G(GMPORIG(.12)),U)="I",$P(GMPFLD(.12),U)="A" D REACTV S AUDITED=1 24 I +$G(GMPORIG(1.01))'=(+GMPFLD(1.01)) D REFORM S AUDITED=1 25 S GMPFLD(.01)=+GMPFLD(.01) ;to remove text left by ?? lex (~) 26 F FLD=.01,.05,.12,.13,1.01,1.05,1.06,1.07,1.08,1.09,1.1,1.11,1.12,1.13,1.14,1.15,1.16 D 27 . Q:'$D(GMPFLD(FLD)) Q:$P($G(GMPORIG(FLD)),U)=$P($G(GMPFLD(FLD)),U) 28 . S DR=DR_";"_FLD_"////"_$S($P(GMPFLD(FLD),U)'="":$P(GMPFLD(FLD),U),1:"@") 29 . Q:AUDITED S CHNGE=GMPIFN_U_FLD_U_NOW_U_DUZ_U_$P(GMPORIG(FLD),U)_U_$P(GMPFLD(FLD),U)_"^^"_+$G(GMPROV) 30 . D AUDIT^GMPLX(CHNGE,"") 31 S DA=GMPIFN,DIE="^AUPNPROB(" D ^DIE S GMPSAVED=1 32 NOTES ; Save Changes to Notes 33 F I=0:0 S I=$O(GMPORIG(10,I)) Q:I'>0 I GMPORIG(10,I)'=GMPFLD(10,I) D 34 . S NIFN=+GMPFLD(10,I),FAC=$P(GMPFLD(10,I),U,2),TEXT=$P(GMPFLD(10,I),U,3),OLDTEXT=$P(GMPORIG(10,I),U,3) 35 . S NODE=$G(^AUPNPROB(GMPIFN,11,FAC,11,NIFN,0)) 36 . I TEXT'="" S $P(^AUPNPROB(GMPIFN,11,FAC,11,NIFN,0),U,3)=TEXT D 37 .. I TEXT=OLDTEXT Q 38 .. S CHNGE=GMPIFN_"^1101^"_NOW_U_DUZ_"^C^^Note Modified^"_+$G(GMPROV) 39 . I TEXT=OLDTEXT Q 40 . I TEXT="" S CHNGE=GMPIFN_"^1101^"_NOW_U_DUZ_"^A^^Deleted Note^"_+$G(GMPROV) 41 . D AUDIT^GMPLX(CHNGE,NODE) 42 . I TEXT="" D 43 .. S DIK="^AUPNPROB("_GMPIFN_",11,"_FAC_",11," 44 .. S DA(2)=GMPIFN,DA(1)=FAC,DA=NIFN D ^DIK 45 I $D(GMPFLD(10,"NEW"))>9 D NEWNOTE 46 EXIT ; Quit Saving Changes 47 D:$G(GMPSAVED) DTMOD^GMPLX(GMPIFN) 48 Q 49 ; 50 REFORM ; Audit Entry that has been Reformulated 51 S CHNGE=GMPIFN_"^1.01^"_NOW_U_DUZ_U_+GMPORIG(1.01)_U_+GMPFLD(1.01)_"^Reformulated^"_+$G(GMPROV) 52 S NODE=$G(^AUPNPROB(GMPIFN,0))_U_$G(^AUPNPROB(GMPIFN,1)) 53 D AUDIT^GMPLX(CHNGE,NODE) 54 Q 55 ; 56 REACTV ; Audit Entry that has been Reactivated 57 S CHNGE=GMPIFN_"^.12^"_NOW_U_DUZ_"^I^A^Reactivated^"_+$G(GMPROV) 58 S NODE=$G(^AUPNPROB(GMPIFN,0))_U_$G(^AUPNPROB(GMPIFN,1)) 59 D AUDIT^GMPLX(CHNGE,NODE) 60 Q 61 ; 62 NEW ; Save Collected Values in new Problem Entry 63 ; Output DA (left defined) 64 N DATA,APCDLOOK,APCDALVR,NUM,I,DIK,GMPIFN,X 65 S:'GMPFLD(.01) GMPFLD(.01)=$$NOS^GMPLX 66 S:$P(+GMPFLD(.01),U)=-1 GMPFLD(.01)=$$NOS^GMPLX ;chk for error from ICD 67 S GMPFLD(.01)=+GMPFLD(.01) ;to remove text left by ?? lex (~) 68 S:'GMPFLD(1.01) GMPFLD(1.01)="1^Unresolved" 69 S:'GMPFLD(.05) X=$P(GMPFLD(.05),U,2),GMPFLD(.05)=$$PROVNARR^GMPLX(X,+GMPFLD(1.01)) 70 S DA=$$NEWPROB(+GMPFLD(.01),+GMPDFN) Q:DA'>0 71 S NUM=$$NEXTNMBR(+GMPDFN,+GMPVAMC),GMPSAVED=1 S:'NUM NUM="" 72 ; Set Node 0 73 S DATA=^AUPNPROB(DA,0)_U_DT_"^^"_$P(GMPFLD(.05),U)_U_+GMPVAMC_U_+NUM_U_DT_"^^^^"_$P(GMPFLD(.12),U)_U_$P(GMPFLD(.13),U) 74 S ^AUPNPROB(DA,0)=DATA 75 ; Set Node 1 76 S DATA=$P(GMPFLD(1.01),U) F I=1.02:.01:1.16 S DATA=DATA_U_$P($G(GMPFLD(+I)),U) 77 S ^AUPNPROB(DA,1)=DATA 78 ; Set X-Refs 79 S DIK="^AUPNPROB(",(APCDLOOK,APCDALVR)=1 D IX1^DIK 80 I $D(GMPFLD(10,"NEW"))>9 S GMPIFN=DA D NEWNOTE 81 Q 82 ; 83 NEWPROB(ICD,DFN) ; Creates New Problem Entry in file #9000011 84 N I,HDR,LAST,TOTAL,DA 85 L +^AUPNPROB(0):1 I '$T D Q -1 86 . W !!,"Someone else is currently editing this file." 87 . W !,"Please try again later.",! 88 S HDR=$G(^AUPNPROB(0)) Q:HDR="" -1 89 S LAST=$P(HDR,U,3),TOTAL=$P(HDR,U,4) 90 F I=(LAST+1):1 Q:'$D(^AUPNPROB(I,0)) 91 S DA=I,^AUPNPROB(DA,0)=ICD_U_DFN 92 S ^AUPNPROB("B",ICD,DA)="",^AUPNPROB("AC",DFN,DA)="" 93 S $P(^AUPNPROB(0),U,3,4)=DA_U_(TOTAL+1) L -^AUPNPROB(0) 94 Q DA 95 ; 96 NEWNOTE ; Creates New Note Entries for Problem 97 ; Requires GMPIFN Pointer to Problem 98 ; GMPROV Current Provider 99 ; GMPVAMC Facility 100 N HDR,LAST,TOTAL,I,FAC,NIFN 101 L +^AUPNPROB(GMPIFN,11):1 I '$T Q 102 S FAC=+$O(^AUPNPROB(GMPIFN,11,"B",GMPVAMC,0)) I 'FAC D 103 . S:'$D(^AUPNPROB(GMPIFN,11,0)) ^(0)="^9000011.11PA^^" 104 . S HDR=^AUPNPROB(GMPIFN,11,0),LAST=$P(HDR,U,3),TOTAL=$P(HDR,U,4) 105 . F I=(LAST+1):1 Q:'$D(^AUPNPROB(GMPIFN,11,I,0)) 106 . S ^AUPNPROB(GMPIFN,11,I,0)=GMPVAMC,^AUPNPROB(GMPIFN,11,"B",GMPVAMC,I)="" 107 . S FAC=I,$P(^AUPNPROB(GMPIFN,11,0),U,3,4)=FAC_U_(TOTAL+1) 108 I FAC'>0 G NNQ 109 NN1 ; Get New Note 110 S:'$D(^AUPNPROB(GMPIFN,11,FAC,11,0)) ^(0)="^9000011.1111IA^^" 111 S HDR=^AUPNPROB(GMPIFN,11,FAC,11,0),LAST=$P(HDR,U,3),TOTAL=$P(HDR,U,4) 112 F I=(LAST+1):1 Q:'$D(^AUPNPROB(GMPIFN,11,FAC,11,I,0)) 113 S NIFN=I 114 F I=0:0 S I=$O(GMPFLD(10,"NEW",I)) Q:I'>0 D 115 . S ^AUPNPROB(GMPIFN,11,FAC,11,NIFN,0)=NIFN_"^^"_GMPFLD(10,"NEW",I)_"^A^"_DT_U_+$G(GMPROV) 116 . S ^AUPNPROB(GMPIFN,11,FAC,11,"B",NIFN,NIFN)="" 117 . S TOTAL=TOTAL+1,LAST=NIFN,NIFN=NIFN+1 118 S $P(^AUPNPROB(GMPIFN,11,FAC,11,0),U,3,4)=LAST_U_TOTAL 119 NNQ ; Quit Getting New Notes 120 L -^AUPNPROB(GMPIFN,11) 121 Q 122 ; 123 NEXTNMBR(DFN,VAMC) ; Returns Next Available Problem Number 124 N I,J,NUM S NUM=1,I="" I '$D(^AUPNPROB("AA",DFN,VAMC)) Q NUM 125 F S I=$O(^AUPNPROB("AA",DFN,VAMC,I)) Q:I="" S J=$E(I,2,999),NUM=+J 126 S NUM=NUM+1 127 Q NUM -
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLUTL.m
r613 r623 1 GMPLUTL ; SLC/MKB/KER -- PL Utilities ; 4/15/2002 2 ;;2.0;Problem List;**3,6,8,10,16,26,35**;Aug 25, 1994;Build 26 3 ; 4 ; External References 5 ; DBIA 348 ^DPT( 6 ; DBIA 10082 ^ICD9( 7 ; DBIA 10006 ^VA(200 8 ; 9 ACTIVE(GMPDFN,GMPL) ; Returns list of Active Problems for a Patient 10 ; 11 ; GMPDFN Pointer to Patient 12 ; GMPL Array in which the problems will be 13 ; returned, passed by reference 14 ; 15 ; GMPL(#,0) Problem file (#9000011) IEN 16 ; GMPL(#,1) Piece 1: Pointer to Problem (Lexicon file #757.01) 17 ; 2: Provider Narrative 18 ; NOTE: the provider narrative may be different 19 ; from the Lexicon term in file 757.01 20 ; GMPL(#,2) Piece 1: Pointer to ICD Diagnosis (file #80) 21 ; 2: ICD-9 Code 22 ; GMPL(#,3) Piece 1: Internal Date of Onset 23 ; 2: External Date of Onset 00/00/00 24 ; GMPL(#,4) Piece 1: Abbreviated Service Connection 25 ; SC^Service Connected 26 ; NSC^Not Service Connected 27 ; null 28 ; 2: Full text Service Connection 29 ; GMPL(#,5) Piece 1: Abbreviated Exposure 30 ; Full text Exposure 31 ; AO^Agent Orange 32 ; IR^Radiation 33 ; EC^Evn Contaminants 34 ; HNC^Head/Neck Cancer 35 ; MST^Mil Sexual Trauma 36 ; CV^Combat Vet 37 ; SHD^SHAD 38 ; null 39 ; 40 N I,IFN,CNT,GMPL0,GMPL1,SP,NUM,ONSET,GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL 41 Q:$G(GMPDFN)'>0 S CNT=0,SP="" 42 S GMPARAM("QUIET")=1,GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R" 43 S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 44 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 45 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 46 . S IFN=+GMPLIST(NUM) Q:IFN'>0 47 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),CNT=CNT+1,GMPL(CNT,0)=IFN 48 . S GMPL(CNT,1)=+GMPL1_U_$$PROBTEXT^GMPLX(IFN) 49 . S GMPL(CNT,2)=+GMPL0_U_$P($G(^ICD9(+GMPL0,0)),U),ONSET=$P(GMPL0,U,13) 50 . S GMPL(CNT,3)=$S(ONSET:ONSET_U_$$EXTDT^GMPLX(ONSET),1:"") 51 . S GMPL(CNT,4)=$S(+$P(GMPL1,U,10):"SC^SERVICE-CONNECTED",$P(GMPL1,U,10)=0:"NSC^NOT SERVICE-CONNECTED",1:"") 52 . F I=11,12,13,15,16,17,18 S:$P(GMPL1,U,I) SP=$S(I=11:"A",I=12:"I",I=13:"P",I=15:"H",16:"M",17:"C",1:"S") 53 . S GMPL(CNT,5)=$S(SP="A":"AO^AGENT ORANGE",SP="I":"IR^RADIATION",SP="P":"EC^ENV CONTAMINANTS",SP="H":"HNC^HEAD AND/OR NECK CANCER",SP="M":"MST^MILIARY SEXUAL TRAUMA",SP="C":"CV^COMBAT VET",SP="S":"SHD^SHAD",1:"") 54 S GMPL(0)=CNT 55 Q 56 ; 57 CREATE(PL,PLY) ; Creates a new problem 58 ; 59 ; Input array, passed by reference 60 ; Required 61 ; PL("PATIENT") Pointer to Patient #2 62 ; PL("NARRATIVE") Text as entered by provider 63 ; PL("PROVIDER") Pointer to provider #200 64 ; Optional 65 ; PL("DIAGNOSIS") Pointer to ICD-9 #80 66 ; PL("LEXICON") Pointer to Lexicon #757.01 67 ; PL("STATUS") A = Active I = Inactive 68 ; PL("ONSET") Internal Date of Onset 69 ; PL("RECORDED") Internal Date Recorded 70 ; PL("RESOLVED") Internal Date Problem was Resolved 71 ; PL("COMMENT") Comment text, up to 60 characters 72 ; PL("LOCATION") Pointer to Hospital Location 73 ; PL("SC") Service Connected 1 = Yes 0 = No 74 ; PL("AO") Agent Orange 1 = Yes 0 = No 75 ; PL("IR") Radiation 1 = Yes 0 = No 76 ; PL("EC") Env Contamination 1 = Yes 0 = No 77 ; PL("HNC") Head/Neck Cancer 1 = Yes 0 = No 78 ; PL("MST") Mil Sexual Trauma 1 = Yes 0 = No 79 ; PL("CV") Combat Vet 1 = Yes 0 = No 80 ; PL("SHD") Shipboard Hazard & Defense 1=Yes 0=No 81 ; 82 ; Output, passed by reference 83 ; PLY Equivalent of Fileman Y, DA 84 ; PLY(0) Equivalent of Fileman Y(0) 85 ; 86 N GMPI,GMPQUIT,GMPVAMC,GMPVA,GMPFLD,GMPSC,GMPAGTOR,GMPION,GMPGULF 87 N GMPHNC,GMPMST,GMPCV,GMPSHD,DA,GMPDFN,GMPROV 88 K PLY S PLY=-1,PLY(0)="" 89 S GMPVAMC=+$G(DUZ(2)),GMPVA=$S($G(DUZ("AG"))="V":1,1:0) 90 I '$L($G(PL("NARRATIVE"))) S PLY(0)="Missing problem narrative" Q 91 I '$D(^DPT(+$G(PL("PATIENT")),0)) S PLY(0)="Invalid patient" Q 92 I '$D(^VA(200,+$G(PL("PROVIDER")),0)) S PLY(0)="Invalid provider" Q 93 S GMPDFN=+PL("PATIENT"),(GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST)=0 94 D:GMPVA VADPT^GMPLX1(GMPDFN) 95 F GMPI="DIAGNOSI","LEXICON","DUPLICAT","LOCATION","STATUS" D @(GMPI_"^GMPLUTL1") Q:$D(GMPQUIT) 96 Q:$D(GMPQUIT) 97 F GMPI="ONSET","RESOLVED","RECORDED","SC","AO","IR","EC","HNC","MST","CV","SHD" D @(GMPI_"^GMPLUTL1") Q:$D(GMPQUIT) 98 Q:$D(GMPQUIT) 99 CR1 ; Ok to Create 100 S GMPFLD(.01)=PL("DIAGNOSIS"),GMPFLD(1.01)=PL("LEXICON") 101 S GMPFLD(.05)=U_$E(PL("NARRATIVE"),1,80) 102 S (GMPROV,GMPFLD(1.04),GMPFLD(1.05))=+PL("PROVIDER") 103 S GMPFLD(1.06)=$$SERVICE^GMPLX1(+PL("PROVIDER")) 104 S GMPFLD(.13)=PL("ONSET"),GMPFLD(1.09)=PL("RECORDED") 105 S GMPFLD(1.02)=$S('$P(^GMPL(125.99,1,0),U,2):"P",$G(GMPLUSER):"P",1:"T") 106 S GMPFLD(.12)=PL("STATUS"),GMPFLD(1.14)="",GMPFLD(1.07)=PL("RESOLVED") 107 S GMPFLD(10,0)=0,GMPFLD(1.03)=$G(DUZ),GMPFLD(1.08)=PL("LOCATION") 108 S:$L($G(PL("COMMENT"))) GMPFLD(10,"NEW",1)=$E(PL("COMMENT"),1,60) 109 S GMPFLD(1.1)=PL("SC"),GMPFLD(1.11)=PL("AO"),GMPFLD(1.12)=PL("IR") 110 S GMPFLD(1.13)=PL("EC"),GMPFLD(1.15)=$G(PL("HNC")),GMPFLD(1.16)=$G(PL("MST")) 111 S GMPFLD(1.17)=$G(PL("CV")),GMPFLD(1.18)=$G(PL("SHD")) 112 D NEW^GMPLSAVE S PLY=DA 113 CRQ ; Quit Create 114 Q 115 ; 116 UPDATE(PL,PLY) ; Update a Problem/Create if Not Found 117 ; 118 ; Input array, passed by reference 119 ; Required 120 ; PL("PROBLEM") Pointer to Problem #9000011 121 ; PL("PROVIDER") Pointer to provider #200 122 ; 123 ; Optional 124 ; PL("NARRATIVE") Text as entered by provider 125 ; PL("DIAGNOSIS") Pointer to ICD-9 #80 126 ; PL("LEXICON") Pointer to Lexicon #757.01 127 ; PL("STATUS") A = Active I = Inactive 128 ; PL("ONSET") Internal Date of Onset 129 ; PL("RECORDED") Internal Date Recorded 130 ; PL("RESOLVED") Internal Date Problem was Resolved 131 ; PL("COMMENT") Comment text, up to 60 characters 132 ; PL("LOCATION") Pointer to Hospital Location 133 ; PL("SC") Service Connected 1 = Yes 0 = No 134 ; PL("AO") Agent Orange 1 = Yes 0 = No 135 ; PL("IR") Radiation 1 = Yes 0 = No 136 ; PL("EC") Env Contamination 1 = Yes 0 = No 137 ; PL("HNC") Head/Neck Cancer 1 = Yes 0 = No 138 ; PL("MST") Mil Sexual Trauma 1 = Yes 0 = No 139 ; PL("CV") Combat Veteran 1 = Yes 0 = No 140 ; PL("SHD") SHAD 1 = Yes 0 = No 141 ; 142 ; Output, passed by reference 143 ; PLY Equivalent of Fileman Y, DA 144 ; PLY(0) Equivalent of Fileman Y(0) 145 ; 146 N GMPORIG,GMPFLD,FLD,ITEMS,SUB,GMPI,DIFFRENT,GMPIFN,GMPVAMC,GMPVA,GMPROV,GMPQUIT,GMPDFN 147 S GMPVAMC=+$G(DUZ(2)),GMPVA=$S($G(DUZ("AG"))="V":1,1:0),PLY=-1,PLY(0)="" 148 S GMPIFN=$G(PL("PROBLEM")) I GMPIFN="" D CREATE(.PL,.PLY) Q 149 I '$D(^AUPNPROB(GMPIFN,0)) S PLY(0)="Invalid problem" Q 150 I '$D(^VA(200,+$G(PL("PROVIDER")),0)) S PLY(0)="Invalid provider" Q 151 S GMPROV=+$G(PL("PROVIDER")),GMPDFN=+$P(^AUPNPROB(GMPIFN,0),U,2) 152 D GETFLDS^GMPLEDT3(GMPIFN) I '$D(GMPFLD) S PLY(0)="Invalid problem" Q 153 I +$G(PL("PATIENT")),+PL("PATIENT")'=GMPDFN S PLY(0)="Patient does not match for this problem" Q 154 I $L($G(PL("RECORDED"))) S PLY(0)="Date Recorded is not editable" Q 155 S (GMPSC,GMPAGTOR,GMPION,GMPGULF)=0 D:GMPVA VADPT^GMPLX1(GMPDFN) 156 S ITEMS="LEXICON^DIAGNOSIS^LOCATION^STATUS^ONSET^RESOLVED^SC^AO^IR^EC^HNC^MST^SHD",FLD="1.01^.01^1.08^.12^.13^1.07^1.1^1.11^1.12^1.13^1.15^1.16^1.17^1.18" 157 F GMPI=1:1 S SUB=$P(ITEMS,U,GMPI) Q:SUB="" D Q:$D(GMPQUIT) 158 . I '$L($G(PL(SUB))) S PL(SUB)=$P(GMPFLD($P(FLD,U,GMPI)),U) Q 159 . I SUB="STATUS",PL(SUB)="@" S GMPQUIT=1,PLY(0)="Cannot delete problem status" Q 160 . I PL(SUB)'="@" D @($E(SUB,1,8)_"^GMPLUTL1") Q:$D(GMPQUIT) 161 . S GMPFLD($P(FLD,U,GMPI))=$S(PL(SUB)="@":"",1:PL(SUB)),DIFFRENT=1 162 Q:$D(GMPQUIT) 163 I +GMPFLD(1.07),GMPFLD(1.07)<GMPFLD(.13) S PLY(0)="Date Resolved cannot be prior to Date of Onset" Q 164 I +GMPFLD(1.09),GMPFLD(1.09)<GMPFLD(.13) S PLY(0)="Date Recorded cannot be prior to Date of Onset" Q 165 S:$L($G(PL("NARRATIVE"))) GMPFLD(.05)=U_PL("NARRATIVE"),DIFFRENT=1 166 S:$L($G(PL("COMMENT"))) GMPFLD(10,"NEW",1)=$E(PL("COMMENT"),1,60),DIFFRENT=1 167 D:$D(DIFFRENT) EN^GMPLSAVE S PLY=GMPIFN,PLY(0)="" 168 Q 1 GMPLUTL ; SLC/MKB/KER -- PL Utilities ; 04/15/2002 2 ;;2.0;Problem List;**3,6,8,10,16,26**;Aug 25, 1994 3 ; 4 ; External References 5 ; DBIA 348 ^DPT( 6 ; DBIA 10082 ^ICD9( 7 ; DBIA 10006 ^VA(200 8 ; 9 ACTIVE(GMPDFN,GMPL) ; Returns list of Active Problems for a Patient 10 ; 11 ; GMPDFN Pointer to Patient 12 ; GMPL Array in which the problems will be 13 ; returned, passed by reference 14 ; 15 ; GMPL(#,0) Problem file (#9000011) IEN 16 ; GMPL(#,1) Piece 1: Pointer to Problem (Lexicon file #757.01) 17 ; 2: Provider Narrative 18 ; NOTE: the provider narrative may be different 19 ; from the Lexicon term in file 757.01 20 ; GMPL(#,2) Piece 1: Pointer to ICD Diagnosis (file #80) 21 ; 2: ICD-9 Code 22 ; GMPL(#,3) Piece 1: Internal Date of Onset 23 ; 2: External Date of Onset 00/00/00 24 ; GMPL(#,4) Piece 1: Abbreviated Service Connection 25 ; SC^Service Connected 26 ; NSC^Not Service Connected 27 ; null 28 ; 2: Full text Service Connection 29 ; GMPL(#,5) Piece 1: Abbreviated Exposure 30 ; Full text Exposure 31 ; AO^Agent Orange 32 ; IR^Radiation 33 ; EC^Evn Contaminants 34 ; HNC^Head/Neck Cancer 35 ; MST^Mil Sexual Trauma 36 ; null 37 ; 38 N I,IFN,CNT,GMPL0,GMPL1,SP,NUM,ONSET,GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL 39 Q:$G(GMPDFN)'>0 S CNT=0,SP="" 40 S GMPARAM("QUIET")=1,GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R" 41 S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 42 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 43 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 44 . S IFN=+GMPLIST(NUM) Q:IFN'>0 45 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),CNT=CNT+1,GMPL(CNT,0)=IFN 46 . S GMPL(CNT,1)=+GMPL1_U_$$PROBTEXT^GMPLX(IFN) 47 . S GMPL(CNT,2)=+GMPL0_U_$P($G(^ICD9(+GMPL0,0)),U),ONSET=$P(GMPL0,U,13) 48 . S GMPL(CNT,3)=$S(ONSET:ONSET_U_$$EXTDT^GMPLX(ONSET),1:"") 49 . S GMPL(CNT,4)=$S(+$P(GMPL1,U,10):"SC^SERVICE-CONNECTED",$P(GMPL1,U,10)=0:"NSC^NOT SERVICE-CONNECTED",1:"") 50 . F I=11,12,13,15,16 S:$P(GMPL1,U,I) SP=$S(I=11:"A",I=12:"I",I=13:"P",I=15:"H",1:"M") 51 . S GMPL(CNT,5)=$S(SP="A":"AO^AGENT ORANGE",SP="I":"IR^RADIATION",SP="P":"EC^ENV CONTAMINANTS",SP="H":"HNC^HEAD AND/OR NECK CANCER",SP="M":"MST^MILIARY SEXUAL TRAUMA",1:"") 52 S GMPL(0)=CNT 53 Q 54 ; 55 CREATE(PL,PLY) ; Creates a new problem 56 ; 57 ; Input array, passed by reference 58 ; Required 59 ; PL("PATIENT") Pointer to Patient #2 60 ; PL("NARRATIVE") Text as entered by provider 61 ; PL("PROVIDER") Pointer to provider #200 62 ; Optional 63 ; PL("DIAGNOSIS") Pointer to ICD-9 #80 64 ; PL("LEXICON") Pointer to Lexicon #757.01 65 ; PL("STATUS") A = Active I = Inactive 66 ; PL("ONSET") Internal Date of Onset 67 ; PL("RECORDED") Internal Date Recorded 68 ; PL("RESOLVED") Internal Date Problem was Resolved 69 ; PL("COMMENT") Comment text, up to 60 characters 70 ; PL("LOCATION") Pointer to Hospital Location 71 ; PL("SC") Service Connected 1 = Yes 0 = No 72 ; PL("AO") Agent Orange 1 = Yes 0 = No 73 ; PL("IR") Radiation 1 = Yes 0 = No 74 ; PL("EC") Env Contamination 1 = Yes 0 = No 75 ; PL("HNC") Head/Neck Cancer 1 = Yes 0 = No 76 ; PL("MST") Mil Sexual Trauma 1 = Yes 0 = No 77 ; 78 ; Output, passed by reference 79 ; PLY Equivalent of Fileman Y, DA 80 ; PLY(0) Equivalent of Fileman Y(0) 81 ; 82 N GMPI,GMPQUIT,GMPVAMC,GMPVA,GMPFLD,GMPSC,GMPAGTOR,GMPION,GMPGULF 83 N GMPHNC,GMPMST,DA,GMPDFN,GMPROV 84 K PLY S PLY=-1,PLY(0)="" 85 S GMPVAMC=+$G(DUZ(2)),GMPVA=$S($G(DUZ("AG"))="V":1,1:0) 86 I '$L($G(PL("NARRATIVE"))) S PLY(0)="Missing problem narrative" Q 87 I '$D(^DPT(+$G(PL("PATIENT")),0)) S PLY(0)="Invalid patient" Q 88 I '$D(^VA(200,+$G(PL("PROVIDER")),0)) S PLY(0)="Invalid provider" Q 89 S GMPDFN=+PL("PATIENT"),(GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST)=0 90 D:GMPVA VADPT^GMPLX1(GMPDFN) 91 F GMPI="DIAGNOSI","LEXICON","DUPLICAT","LOCATION","STATUS" D @(GMPI_"^GMPLUTL1") Q:$D(GMPQUIT) 92 Q:$D(GMPQUIT) 93 F GMPI="ONSET","RESOLVED","RECORDED","SC","AO","IR","EC","HNC","MST" D @(GMPI_"^GMPLUTL1") Q:$D(GMPQUIT) 94 Q:$D(GMPQUIT) 95 CR1 ; Ok to Create 96 S GMPFLD(.01)=PL("DIAGNOSIS"),GMPFLD(1.01)=PL("LEXICON") 97 S GMPFLD(.05)=U_$E(PL("NARRATIVE"),1,80) 98 S (GMPROV,GMPFLD(1.04),GMPFLD(1.05))=+PL("PROVIDER") 99 S GMPFLD(1.06)=$$SERVICE^GMPLX1(+PL("PROVIDER")) 100 S GMPFLD(.13)=PL("ONSET"),GMPFLD(1.09)=PL("RECORDED") 101 S GMPFLD(1.02)=$S('$P(^GMPL(125.99,1,0),U,2):"P",$G(GMPLUSER):"P",1:"T") 102 S GMPFLD(.12)=PL("STATUS"),GMPFLD(1.14)="",GMPFLD(1.07)=PL("RESOLVED") 103 S GMPFLD(10,0)=0,GMPFLD(1.03)=$G(DUZ),GMPFLD(1.08)=PL("LOCATION") 104 S:$L($G(PL("COMMENT"))) GMPFLD(10,"NEW",1)=$E(PL("COMMENT"),1,60) 105 S GMPFLD(1.1)=PL("SC"),GMPFLD(1.11)=PL("AO"),GMPFLD(1.12)=PL("IR") 106 S GMPFLD(1.13)=PL("EC"),GMPFLD(1.15)=$G(PL("HNC")),GMPFLD(1.16)=$G(PL("MST")) 107 D NEW^GMPLSAVE S PLY=DA 108 CRQ ; Quit Create 109 Q 110 ; 111 UPDATE(PL,PLY) ; Update a Problem/Create if Not Found 112 ; 113 ; Input array, passed by reference 114 ; Required 115 ; PL("PROBLEM") Pointer to Problem #9000011 116 ; PL("PROVIDER") Pointer to provider #200 117 ; 118 ; Optional 119 ; PL("NARRATIVE") Text as entered by provider 120 ; PL("DIAGNOSIS") Pointer to ICD-9 #80 121 ; PL("LEXICON") Pointer to Lexicon #757.01 122 ; PL("STATUS") A = Active I = Inactive 123 ; PL("ONSET") Internal Date of Onset 124 ; PL("RECORDED") Internal Date Recorded 125 ; PL("RESOLVED") Internal Date Problem was Resolved 126 ; PL("COMMENT") Comment text, up to 60 characters 127 ; PL("LOCATION") Pointer to Hospital Location 128 ; PL("SC") Service Connected 1 = Yes 0 = No 129 ; PL("AO") Agent Orange 1 = Yes 0 = No 130 ; PL("IR") Radiation 1 = Yes 0 = No 131 ; PL("EC") Env Contamination 1 = Yes 0 = No 132 ; PL("HNC") Head/Neck Cancer 1 = Yes 0 = No 133 ; PL("MST") Mil Sexual Trauma 1 = Yes 0 = No 134 ; 135 ; Output, passed by reference 136 ; PLY Equivalent of Fileman Y, DA 137 ; PLY(0) Equivalent of Fileman Y(0) 138 ; 139 N GMPORIG,GMPFLD,FLD,ITEMS,SUB,GMPI,DIFFRENT,GMPIFN,GMPVAMC,GMPVA,GMPROV,GMPQUIT,GMPDFN 140 S GMPVAMC=+$G(DUZ(2)),GMPVA=$S($G(DUZ("AG"))="V":1,1:0),PLY=-1,PLY(0)="" 141 S GMPIFN=$G(PL("PROBLEM")) I GMPIFN="" D CREATE(.PL,.PLY) Q 142 I '$D(^AUPNPROB(GMPIFN,0)) S PLY(0)="Invalid problem" Q 143 I '$D(^VA(200,+$G(PL("PROVIDER")),0)) S PLY(0)="Invalid provider" Q 144 S GMPROV=+$G(PL("PROVIDER")),GMPDFN=+$P(^AUPNPROB(GMPIFN,0),U,2) 145 D GETFLDS^GMPLEDT3(GMPIFN) I '$D(GMPFLD) S PLY(0)="Invalid problem" Q 146 I +$G(PL("PATIENT")),+PL("PATIENT")'=GMPDFN S PLY(0)="Patient does not match for this problem" Q 147 I $L($G(PL("RECORDED"))) S PLY(0)="Date Recorded is not editable" Q 148 S (GMPSC,GMPAGTOR,GMPION,GMPGULF)=0 D:GMPVA VADPT^GMPLX1(GMPDFN) 149 S ITEMS="LEXICON^DIAGNOSIS^LOCATION^STATUS^ONSET^RESOLVED^SC^AO^IR^EC^HNC^MST^",FLD="1.01^.01^1.08^.12^.13^1.07^1.1^1.11^1.12^1.13^1.15^1.16" 150 F GMPI=1:1 S SUB=$P(ITEMS,U,GMPI) Q:SUB="" D Q:$D(GMPQUIT) 151 . I '$L($G(PL(SUB))) S PL(SUB)=$P(GMPFLD($P(FLD,U,GMPI)),U) Q 152 . I SUB="STATUS",PL(SUB)="@" S GMPQUIT=1,PLY(0)="Cannot delete problem status" Q 153 . I PL(SUB)'="@" D @($E(SUB,1,8)_"^GMPLUTL1") Q:$D(GMPQUIT) 154 . S GMPFLD($P(FLD,U,GMPI))=$S(PL(SUB)="@":"",1:PL(SUB)),DIFFRENT=1 155 Q:$D(GMPQUIT) 156 I +GMPFLD(1.07),GMPFLD(1.07)<GMPFLD(.13) S PLY(0)="Date Resolved cannot be prior to Date of Onset" Q 157 I +GMPFLD(1.09),GMPFLD(1.09)<GMPFLD(.13) S PLY(0)="Date Recorded cannot be prior to Date of Onset" Q 158 S:$L($G(PL("NARRATIVE"))) GMPFLD(.05)=U_PL("NARRATIVE"),DIFFRENT=1 159 S:$L($G(PL("COMMENT"))) GMPFLD(10,"NEW",1)=$E(PL("COMMENT"),1,60),DIFFRENT=1 160 D:$D(DIFFRENT) EN^GMPLSAVE S PLY=GMPIFN,PLY(0)="" 161 Q -
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLUTL1.m
r613 r623 1 GMPLUTL1 ; SLC/MKB/KER -- PL Utilities (cont) ; 04/15/2002 2 ;;2.0;Problem List;**3,8,7,9,26,35**;Aug 25, 1994;Build 26 3 ; 4 ; External References 5 ; DBIA 446 ^AUTNPOV( 6 ; DBIA 10082 ^ICD9( 7 ; DBIA 1571 ^LEX(757.01 8 ; DBIA 10040 ^SC( 9 ; DBIA 10060 ^VA(200 10 ; DBIA 10003 ^%DT 11 ; DBIA 10104 $$UP^XLFSTR 12 ; 13 ; All entry points in this routine expect the 14 ; PL("data item") array from routine ^GMPLUTL. 15 ; 16 ; Entry Expected Variable 17 ; Point From VADPT^GMPLX1 18 ; AO GMPAGTOR 19 ; IR GMPION 20 ; EC GMPGULF 21 ; HNC GMPHNC 22 ; MST GMPMST 23 ; CV GMPCV 24 ; SHD GMPSHD 25 ; 26 Q 27 DIAGNOSI ; ICD Diagnosis Pointer 28 S:'$L($G(PL("DIAGNOSIS"))) PL("DIAGNOSIS")=$$NOS^GMPLX 29 Q:$D(^ICD9(+PL("DIAGNOSIS"),0)) 30 S GMPQUIT=1,PLY(0)="Invalid ICD Diagnosis" 31 Q 32 ; 33 LEXICON ; Clinical Lexicon Pointer 34 S:'$L($G(PL("LEXICON"))) PL("LEXICON")=1 35 Q:$D(^LEX(757.01,+PL("LEXICON"),0)) 36 S GMPQUIT=1,PLY(0)="Invalid Lexicon term" 37 Q 38 DUPLICAT ; Problem Already on the List 39 N DUPL 40 Q:$P($G(^GMPL(125.99,1,0)),U,6)'=1 41 S:'$L($G(PL("DIAGNOSIS"))) PL("DIAGNOSIS")=$$NOS^GMPLX 42 I '$D(^AUPNPROB("B",+PL("DIAGNOSIS")))!('$D(^AUPNPROB("AC",GMPDFN))) Q 43 F IFN=0:0 S IFN=$O(^AUPNPROB("AC",GMPDFN,IFN)) Q:IFN'>0 D Q:$D(GMPQUIT) 44 . S (DUPL(1),DUPL(2))=0 45 . S NODE0=$G(^AUPNPROB(IFN,0)),NODE1=$G(^(1)) Q:$P(NODE1,U,2)="H" 46 . I +PL("DIAGNOSIS")=+NODE0 S DUPL(1)=IFN 47 . S:PL("NARRATIVE")=$$UP^XLFSTR($P(^AUTNPOV($P(NODE0,U,5),0),U)) DUPL(2)=IFN 48 . I DUPL(1)>0&DUPL(2)>0 S GMPQUIT=1,PLY(0)="Duplicate problem" 49 Q 50 ; 51 LOCATION ; Hospital Location (Clinic) Pointer 52 S:'$D(PL("LOCATION")) PL("LOCATION")="" Q:'$L(PL("LOCATION")) 53 I $D(^SC(+PL("LOCATION"),0)),$P(^(0),U,3)="C" Q 54 S GMPQUIT=1,PLY(0)="Invalid hospital location" 55 Q 56 ; 57 PROVIDER ; Responsible Provider 58 S:'$D(PL("PROVIDER")) PL("PROVIDER")="" 59 Q:'$L(PL("PROVIDER")) Q:$D(^VA(200,+PL("PROVIDER"),0)) 60 S GMPQUIT=1,PLY(0)="Invalid provider" 61 Q 62 ; 63 STATUS ; Problem Status 64 S:$G(PL("STATUS"))="" PL("STATUS")="A" 65 I "^A^I^a^i^"[(U_PL("STATUS")_U) S PL("STATUS")=$$UP^XLFSTR(PL("STATUS")) Q 66 S GMPQUIT=1,PLY(0)="Invalid problem status" 67 Q 68 ; 69 ONSET ; Date of Onset 70 N %DT,Y,X 71 S:'$D(PL("ONSET")) PL("ONSET")="" Q:'$L(PL("ONSET")) 72 S %DT="P",%DT(0)="-NOW",X=PL("ONSET") D ^%DT 73 I Y>0 S PL("ONSET")=Y Q 74 S GMPQUIT=1,PLY(0)="Invalid Date of Onset" 75 Q 76 ; 77 RESOLVED ; Date Resolved (Requires STATUS, ONSET) 78 N %DT,Y,X 79 S:'$D(PL("RESOLVED")) PL("RESOLVED")="" Q:'$L(PL("RESOLVED")) 80 S %DT="P",%DT(0)="-NOW",X=PL("RESOLVED") D ^%DT 81 I Y'>0 S GMPQUIT=1,PLY(0)="Invalid Date Resolved" Q 82 I PL("STATUS")="A" S GMPQUIT=1,PLY(0)="Active problems cannot have a Date Resolved" Q 83 I Y<PL("ONSET") S GMPQUIT=1,PLY(0)="Date Resolved cannot be prior to Date of Onset" Q 84 S PL("RESOLVED")=Y 85 Q 86 ; 87 RECORDED ; Date Recorded (Requires ONSET) 88 N %DT,Y,X 89 S:'$D(PL("RECORDED")) PL("RECORDED")="" Q:'$L(PL("RECORDED")) 90 S %DT="P",%DT(0)="-NOW",X=PL("RECORDED") D ^%DT 91 I Y'>0 S GMPQUIT=1,PLY(0)="Invalid Date Recorded" Q 92 I PL("RECORDED")<PL("ONSET") S GMPQUIT=1,PLY(0)="Date Recorded cannot be prior to Date of Onset" Q 93 S PL("RECORDED")=Y 94 Q 95 ; 96 SC ; SC condition flag 97 S:'$D(PL("SC")) PL("SC")="" 98 I "^^1^0^"'[(U_PL("SC")_U) S GMPQUIT=1,PLY(0)="Invalid SC flag" Q 99 I 'GMPSC,+PL("SC") S GMPQUIT=1,PLY(0)="Invalid SC flag" 100 Q 101 ; 102 AO ; AO exposure flag (Requires GMPAGTOR) 103 S:'$D(PL("AO")) PL("AO")="" 104 I "^^1^0^"'[(U_PL("AO")_U) S GMPQUIT=1,PLY(0)="Invalid AO flag" Q 105 I 'GMPAGTOR,+PL("AO") S GMPQUIT=1,PLY(0)="Invalid AO flag" 106 Q 107 ; 108 IR ; IR exposure flag (Requires GMPION) 109 S:'$D(PL("IR")) PL("IR")="" 110 I "^^1^0^"'[(U_PL("IR")_U) S GMPQUIT=1,PLY(0)="Invalid IR flag" Q 111 I 'GMPION,+PL("IR") S GMPQUIT=1,PLY(0)="Invalid IR flag" 112 Q 113 ; 114 EC ; EC exposure flag (Requires GMPGULF) 115 S:'$D(PL("EC")) PL("EC")="" 116 I "^^1^0^"'[(U_PL("EC")_U) S GMPQUIT=1,PLY(0)="Invalid EC flag" Q 117 I 'GMPGULF,+PL("EC") S GMPQUIT=1,PLY(0)="Invalid EC flag" 118 Q 119 HNC ; HNC/NTR exposure flag (Requires GMPHNC) 120 S:'$D(PL("HNC")) PL("HNC")="" 121 I "^^1^0^"'[(U_PL("HNC")_U) S GMPQUIT=1,PLY(0)="Invalid HNC flag" Q 122 I 'GMPHNC,+PL("HNC") S GMPQUIT=1,PLY(0)="Invalid HNC flag" 123 Q 124 MST ; MST exposure flag (Requires GMPMST) 125 S:'$D(PL("MST")) PL("MST")="" 126 I "^^1^0^"'[(U_PL("MST")_U) S GMPQUIT=1,PLY(0)="Invalid MST flag" Q 127 I 'GMPMST,+PL("MST") S GMPQUIT=1,PLY(0)="Invalid MST flag" 128 Q 129 CV ; CV exposure flag (Requires GMPCV) 130 S:'$D(PL("CV")) PL("CV")="" 131 I "^^1^0^"'[(U_PL("CV")_U) S GMPQUIT=1,PLY(0)="Invalid CV flag" Q 132 I 'GMPSHD,+PL("CV") S GMPQUIT=1,PLY(0)="Invalid CV flag" 133 Q 134 SHD ; SHD exposure flag (Requires GMPSHD) 135 S:'$D(PL("SHD")) PL("SHD")="" 136 I "^^1^0^"'[(U_PL("SHD")_U) S GMPQUIT=1,PLY(0)="Invalid SHD flag" Q 137 I 'GMPSHD,+PL("SHD") S GMPQUIT=1,PLY(0)="Invalid SHD flag" 138 Q 1 GMPLUTL1 ; SLC/MKB/KER -- PL Utilities (cont) ; 04/15/2002 2 ;;2.0;Problem List;**3,8,7,9,26**;Aug 25, 1994;Build 1 3 ; 4 ; External References 5 ; DBIA 446 ^AUTNPOV( 6 ; DBIA 10082 ^ICD9( 7 ; DBIA 1571 ^LEX(757.01 8 ; DBIA 10040 ^SC( 9 ; DBIA 10060 ^VA(200 10 ; DBIA 10003 ^%DT 11 ; DBIA 10104 $$UP^XLFSTR 12 ; 13 ; All entry points in this routine expect the 14 ; PL("data item") array from routine ^GMPLUTL. 15 ; 16 ; Entry Expected Variable 17 ; Point From VADPT^GMPLX1 18 ; AO GMPAGTOR 19 ; IR GMPION 20 ; EC GMPGULF 21 ; HNC GMPHNC 22 ; MST GMPMST 23 ; 24 Q 25 DIAGNOSI ; ICD Diagnosis Pointer 26 S:'$L($G(PL("DIAGNOSIS"))) PL("DIAGNOSIS")=$$NOS^GMPLX 27 Q:$D(^ICD9(+PL("DIAGNOSIS"),0)) 28 S GMPQUIT=1,PLY(0)="Invalid ICD Diagnosis" 29 Q 30 ; 31 LEXICON ; Clinical Lexicon Pointer 32 S:'$L($G(PL("LEXICON"))) PL("LEXICON")=1 33 Q:$D(^LEX(757.01,+PL("LEXICON"),0)) 34 S GMPQUIT=1,PLY(0)="Invalid Lexicon term" 35 Q 36 DUPLICAT ; Problem Already on the List 37 Q:$P($G(^GMPL(125.99,1,0)),U,6)'=1 38 S:'$L($G(PL("DIAGNOSIS"))) PL("DIAGNOSIS")=$$NOS^GMPLX 39 I '$D(^AUPNPROB("B",+PL("DIAGNOSIS")))!('$D(^AUPNPROB("AC",GMPDFN))) Q 40 F IFN=0:0 S IFN=$O(^AUPNPROB("AC",GMPDFN,IFN)) Q:IFN'>0 D Q:$D(GMPQUIT) 41 . S (DUPL(1),DUPL(2))=0 42 . S NODE0=$G(^AUPNPROB(IFN,0)),NODE1=$G(^(1)) Q:$P(NODE1,U,2)="H" 43 . I +PL("DIAGNOSIS")=+NODE0 S DUPL(1)=IFN 44 . S:PL("NARRATIVE")=$$UP^XLFSTR($P(^AUTNPOV($P(NODE0,U,5),0),U)) DUPL(2)=IFN 45 . I DUPL(1)>0&DUPL(2)>0 S GMPQUIT=1,PLY(0)="Duplicate problem" 46 Q 47 ; 48 LOCATION ; Hospital Location (Clinic) Pointer 49 S:'$D(PL("LOCATION")) PL("LOCATION")="" Q:'$L(PL("LOCATION")) 50 I $D(^SC(+PL("LOCATION"),0)),$P(^(0),U,3)="C" Q 51 S GMPQUIT=1,PLY(0)="Invalid hospital location" 52 Q 53 ; 54 PROVIDER ; Responsible Provider 55 S:'$D(PL("PROVIDER")) PL("PROVIDER")="" 56 Q:'$L(PL("PROVIDER")) Q:$D(^VA(200,+PL("PROVIDER"),0)) 57 S GMPQUIT=1,PLY(0)="Invalid provider" 58 Q 59 ; 60 STATUS ; Problem Status 61 S:$G(PL("STATUS"))="" PL("STATUS")="A" 62 I "^A^I^a^i^"[(U_PL("STATUS")_U) S PL("STATUS")=$$UP^XLFSTR(PL("STATUS")) Q 63 S GMPQUIT=1,PLY(0)="Invalid problem status" 64 Q 65 ; 66 ONSET ; Date of Onset 67 N %DT,Y,X 68 S:'$D(PL("ONSET")) PL("ONSET")="" Q:'$L(PL("ONSET")) 69 S %DT="P",%DT(0)="-NOW",X=PL("ONSET") D ^%DT 70 I Y>0 S PL("ONSET")=Y Q 71 S GMPQUIT=1,PLY(0)="Invalid Date of Onset" 72 Q 73 ; 74 RESOLVED ; Date Resolved (Requires STATUS, ONSET) 75 N %DT,Y,X 76 S:'$D(PL("RESOLVED")) PL("RESOLVED")="" Q:'$L(PL("RESOLVED")) 77 S %DT="P",%DT(0)="-NOW",X=PL("RESOLVED") D ^%DT 78 I Y'>0 S GMPQUIT=1,PLY(0)="Invalid Date Resolved" Q 79 I PL("STATUS")="A" S GMPQUIT=1,PLY(0)="Active problems cannot have a Date Resolved" Q 80 I Y<PL("ONSET") S GMPQUIT=1,PLY(0)="Date Resolved cannot be prior to Date of Onset" Q 81 S PL("RESOLVED")=Y 82 Q 83 ; 84 RECORDED ; Date Recorded (Requires ONSET) 85 N %DT,Y,X 86 S:'$D(PL("RECORDED")) PL("RECORDED")="" Q:'$L(PL("RECORDED")) 87 S %DT="P",%DT(0)="-NOW",X=PL("RECORDED") D ^%DT 88 I Y'>0 S GMPQUIT=1,PLY(0)="Invalid Date Recorded" Q 89 I PL("RECORDED")<PL("ONSET") S GMPQUIT=1,PLY(0)="Date Recorded cannot be prior to Date of Onset" Q 90 S PL("RECORDED")=Y 91 Q 92 ; 93 SC ; SC condition flag 94 S:'$D(PL("SC")) PL("SC")="" 95 I "^^1^0^"'[(U_PL("SC")_U) S GMPQUIT=1,PLY(0)="Invalid SC flag" Q 96 I 'GMPSC,+PL("SC") S GMPQUIT=1,PLY(0)="Invalid SC flag" 97 Q 98 ; 99 AO ; AO exposure flag (Requires GMPAGTOR) 100 S:'$D(PL("AO")) PL("AO")="" 101 I "^^1^0^"'[(U_PL("AO")_U) S GMPQUIT=1,PLY(0)="Invalid AO flag" Q 102 I 'GMPAGTOR,+PL("AO") S GMPQUIT=1,PLY(0)="Invalid AO flag" 103 Q 104 ; 105 IR ; IR exposure flag (Requires GMPION) 106 S:'$D(PL("IR")) PL("IR")="" 107 I "^^1^0^"'[(U_PL("IR")_U) S GMPQUIT=1,PLY(0)="Invalid IR flag" Q 108 I 'GMPION,+PL("IR") S GMPQUIT=1,PLY(0)="Invalid IR flag" 109 Q 110 ; 111 EC ; EC exposure flag (Requires GMPGULF) 112 S:'$D(PL("EC")) PL("EC")="" 113 I "^^1^0^"'[(U_PL("EC")_U) S GMPQUIT=1,PLY(0)="Invalid EC flag" Q 114 I 'GMPGULF,+PL("EC") S GMPQUIT=1,PLY(0)="Invalid EC flag" 115 Q 116 HNC ; HNC/NTR exposure flag (Requires GMPHNC) 117 S:'$D(PL("HNC")) PL("HNC")="" 118 I "^^1^0^"'[(U_PL("HNC")_U) S GMPQUIT=1,PLY(0)="Invalid HNC flag" Q 119 I 'GMPHNC,+PL("HNC") S GMPQUIT=1,PLY(0)="Invalid HNC flag" 120 Q 121 MST ; MST exposure flag (Requires GMPMST) 122 S:'$D(PL("MST")) PL("MST")="" 123 I "^^1^0^"'[(U_PL("MST")_U) S GMPQUIT=1,PLY(0)="Invalid MST flag" Q 124 I 'GMPMST,+PL("MST") S GMPQUIT=1,PLY(0)="Invalid MST flag" 125 Q -
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLUTL2.m
r613 r623 1 GMPLUTL2 ; SLC/MKB/KER -- PL Utilities (OE/TIU) ; 04/15/2002 2 ;;2.0;Problem List;**10,18,21,26,35**;Aug 25, 1994;Build 26 3 ; External References 4 ; DBIA 348 ^DPT( file #2 5 ; DBIA 10082 ^ICD9( file #80 6 ; DBIA 10040 ^SC( file #44 7 ; DBIA 10060 ^VA(200 8 ; DBIA 2716 $$GETSTAT^DGMSTAPI 9 ; DBIA 3457 $$GETCUR^DGNTAPI 10 ; DBIA 10062 7^VADPT 11 ; DBIA 10062 DEM^VADPT 12 ; DBIA 10118 EN^VALM 13 ; DBIA 10116 CLEAR^VALM1 14 ; DBIA 10103 $$HTFM^XLFDT 15 LIST(GMPL,GMPDFN,GMPSTAT,GMPCOMM) ; Returns list of Prob for Pt. 16 ; Input GMPDFN Pointer to Patient file #2 17 ; GMPCOMP Display Comments 1/0 18 ; GMTSTAT Status A/I/"" 19 ; Output GMPL Array, passed by reference 20 ; GMPL(#) 21 ; Piece 1: Pointer to Problem #9000011 22 ; 2: Status 23 ; 3: Description 24 ; 4: ICD-9 code 25 ; 5: Date of Onset 26 ; 6: Date Last Modified 27 ; 7: Service Connected 28 ; 8: Special Exposures 29 ; GMPL(#,C#) Comments 30 ; GMPL(0) Number of Problems Returned 31 N I,IFN,CNT,GMPL0,GMPL1,SP,ST,NUM,ONSET,ICD,LASTMOD,SC,GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL 32 Q:$G(GMPDFN)'>0 S CNT=0,SP="" 33 S GMPARAM("QUIET")=1,GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R" 34 S GMPLVIEW("ACT")=GMPSTAT,GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 35 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 36 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 37 . S IFN=+GMPLIST(NUM) Q:IFN'>0 38 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),CNT=CNT+1 39 . S ICD=$P($G(^ICD9(+GMPL0,0)),U),LASTMOD=$P(GMPL0,U,3) 40 . S ST=$P(GMPL0,U,12),ONSET=$P(GMPL0,U,13) 41 . S SC=$S(+$P(GMPL1,U,10):"SC",$P(GMPL1,U,10)=0:"NSC",1:"") 42 . N SCS D SCS^GMPLX1(IFN,.SCS) S SP=$G(SCS(3)) 43 . S GMPL(CNT)=IFN_U_ST_U_$$PROBTEXT^GMPLX(IFN)_U_ICD_U_ONSET_U_LASTMOD_U_SC_U_SP_U_$S($P(GMPL1,U,14)="A":"*",1:"")_U_$S('$P($G(^GMPL(125.99,1,0)),U,2):"",$P(GMPL1,U,2)'="T":"",1:"$") 44 . I $G(GMPCOMM) D 45 . . N FAC,NIFN,NOTE,NOTECNT 46 . . S NOTECNT=0,FAC=0 47 . . F S FAC=$O(^AUPNPROB(IFN,11,FAC)) Q:+FAC'>0 D 48 . . . S NIFN=0 49 . . . F S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,NIFN)) Q:NIFN'>0 D 50 . . . . S NOTE=$P($G(^AUPNPROB(IFN,11,FAC,11,NIFN,0)),U,3) 51 . . . . S NOTECNT=NOTECNT+1,GMPL(CNT,NOTECNT)=NOTE 52 S GMPL(0)=CNT 53 Q 54 ; 55 DETAIL(IFN,GMPL) ; Returns Detailed Data for Problem 56 ; 57 ; Input IFN Pointer to Problem file #9000011 58 ; 59 ; Output GMPL Array, passed by reference 60 ; GMPL("DATA NAME") = External Format of Value 61 ; 62 ; GMPL("DIAGNOSIS") ICD Code 63 ; GMPL("PATIENT") Patient Name 64 ; GMPL("MODIFIED") Date Last Modified 65 ; GMPL("NARRATIVE") Provider Narrative 66 ; GMPL("ENTERED") Date Entered ^ Entered by 67 ; GMPL("STATUS") Status 68 ; GMPL("PRIORITY") Priority Acute/Chronic 69 ; GMPL("ONSET") Date of Onset 70 ; GMPL("PROVIDER") Responsible Provider 71 ; GMPL("RECORDED") Date Recorded ^ Recorded by 72 ; GMPL("CLINIC") Hospital Location 73 ; GMPL("SC") Service Connected SC/NSC/"" 74 ; 75 ; GMPL("EXPOSURE") = # 76 ; GMPL("EXPOSURE",X)="AGENT ORANGE" 77 ; GMPL("EXPOSURE",X)="RADIATION" 78 ; GMPL("EXPOSURE",X)="ENV CONTAMINANTS" 79 ; GMPL("EXPOSURE",X)="HEAD AND/OR NECK CANCER" 80 ; GMPL("EXPOSURE",X)="MILITARY SEXUAL TRAUMA" 81 ; GMPL("EXPOSURE",X)="COMBAT VET" 82 ; GMPL("EXPOSURE",X)="SHAD" 83 ; 84 ; GMPL("COMMENT") = # 85 ; GMPL("COMMENT",CNT) = Date ^ Author ^ Text of Note 86 ; 87 N GMPL0,GMPL1,GMPLP,X,I,FAC,CNT,NIFN Q:'$D(^AUPNPROB(IFN,0)) 88 S GMPLP=+($$PTR^GMPLUTL4),GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)) 89 S GMPL("DIAGNOSIS")=$P($G(^ICD9(+GMPL0,0)),U) 90 S GMPL("PATIENT")=$P($G(^DPT(+$P(GMPL0,U,2),0)),U) 91 S GMPL("MODIFIED")=$$EXTDT^GMPLX($P(GMPL0,U,3)) 92 S GMPL("NARRATIVE")=$$PROBTEXT^GMPLX(IFN) 93 S GMPL("ENTERED")=$$EXTDT^GMPLX($P(GMPL0,U,8))_U_$P($G(^VA(200,+$P(GMPL1,U,3),0)),U) 94 S X=$P(GMPL0,U,12),GMPL("STATUS")=$S(X="A":"ACTIVE",1:"INACTIVE") 95 S X=$S(X'="A":"",1:$P(GMPL1,U,14)),GMPL("PRIORITY")=$S(X="A":"ACUTE",X="C":"CHRONIC",1:"") 96 S GMPL("ONSET")=$$EXTDT^GMPLX($P(GMPL0,U,13)) 97 S GMPL("PROVIDER")=$P($G(^VA(200,+$P(GMPL1,U,5),0)),U) 98 S GMPL("RECORDED")=$$EXTDT^GMPLX($P(GMPL1,U,9))_U_$P($G(^VA(200,+$P(GMPL1,U,4),0)),U) 99 S GMPL("CLINIC")=$P($G(^SC(+$P(GMPL1,U,8),0)),U) 100 S GMPL("SC")=$S($P(GMPL1,U,10):"YES",$P(GMPL1,U,10)=0:"NO",1:"UNKNOWN") 101 S GMPL("EXPOSURE")=0 102 I $P(GMPL1,U,11) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="AGENT ORANGE",GMPL("EXPOSURE")=X 103 I $P(GMPL1,U,12) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="RADIATION",GMPL("EXPOSURE")=X 104 I $P(GMPL1,U,13) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="ENV CONTAMINANTS",GMPL("EXPOSURE")=X 105 I $P(GMPL1,U,15) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="HEAD AND/OR NECK CANCER",GMPL("EXPOSURE")=X 106 I $P(GMPL1,U,16) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="MILITARY SEXUAL TRAUMA",GMPL("EXPOSURE")=X 107 I $P(GMPL1,U,17) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="COMBAT VET",GMPL("EXPOSURE")=X 108 I $P(GMPL1,U,18)&(GMPLP'>0) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="SHAD",GMPL("EXPOSURE")=X 109 S (FAC,CNT)=0,GMPL("COMMENT")=0 110 F FAC=0:0 S FAC=$O(^AUPNPROB(IFN,11,FAC)) Q:+FAC'>0 D 111 . F NIFN=0:0 S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,NIFN)) Q:NIFN'>0 D 112 . . S X=$G(^AUPNPROB(IFN,11,FAC,11,NIFN,0)) 113 . . S CNT=CNT+1,GMPL("COMMENT",CNT)=$$EXTDT^GMPLX($P(X,U,5))_U_$P($G(^VA(200,+$P(X,U,6),0)),U)_U_$P(X,U,3) 114 S GMPL("COMMENT")=CNT D AUDIT 115 Q 116 ; 117 AUDIT ; 14 Sep 99 - MA - Add audit trail to OE Problem List. 118 ; Called from DETAIL, requires IFN and sets GMPL("AUDIT") 119 N IDT,AIFN,X0,X1,FLD,CNT 120 S CNT=0,GMPL("AUDIT")=CNT 121 F IDT=0:0 S IDT=$O(^GMPL(125.8,"AD",IFN,IDT)) Q:IDT'>0 D 122 . F AIFN=0:0 S AIFN=$O(^GMPL(125.8,"AD",IFN,IDT,AIFN)) Q:AIFN'>0 D 123 .. S X0=$G(^GMPL(125.8,AIFN,0)),X1=$G(^(1)) Q:'$L(X0) 124 .. S FLD=$$FLDNAME(+$P(X0,U,2)) 125 .. S CNT=CNT+1 126 .. S GMPL("AUDIT",CNT,0)=$P(X0,U,2)_U_FLD_U_$P(X0,U,3,8) 127 .. ; = pointer#^fld name^date mod^who mod^old^new^reason^prov 128 .. S:$L(X1) GMPL("AUDIT",CNT,1)=X1 129 S GMPL("AUDIT")=CNT 130 Q 131 ; 132 FLDNAME(NUM) ; Returns field name for display 133 N NAME,NM1,NM2,I,J S J=0,NAME="" 134 S NM1=".01^.05^.12^.13^1.01^1.02^1.04^1.05^1.06^1.07^1.08^1.09^1.1^1.11^1.12^1.13^1.14^1.17^1.18^1101" 135 F I=1:1:$L(NM1,U) I +$P(NM1,U,I)=+NUM S J=I Q 136 G:J'>0 FNQ 137 S NM2="DIAGNOSIS^PROVIDER NARRATIVE^STATUS^DATE OF ONSET^PROBLEM^CONDITION^RECORDING PROVIDER^RESPONSIBLE PROVIDER" 138 S NM2=NM2_"^SERVICE^DATE RESOLVED^CLINIC^DATE RECORDED^SERVICE CONNECTED^AGENT ORANGE EXP^RADIATION EXP^ENV CONTAMINANTS EXP" 139 S NM2=NM2_"^COMBAT VET^SHIPBOARD HAZARD EXP^PRIORITY^NOTE" 140 S NAME=$P(NM2,U,J) 141 FNQ Q NAME 142 ; 143 ADD(DFN,LOC,GMPROV) ; -- Interactive LMgr action to add new problem 144 N X,Y,GMPDFN,GMPVA,GMPVAMC,GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST,GMPCV,GMPSHD 145 N GMPARAM,GMPLVIEW,GMPLUSER,GMPCLIN,GMPLSLST,GMPQUIT,VALMCC,GMPSAVED 146 Q:'DFN Q:'LOC D SETVARS 147 S GMPLSLST=$P($G(^VA(200,DUZ,125)),U,2),VALMCC=0 148 I 'GMPLSLST,GMPCLIN,$D(^GMPL(125,"C",+GMPCLIN)) S GMPLSLST=$O(^(+GMPCLIN,0)) 149 I GMPLSLST D Q 150 . S $P(GMPLSLST,U,2)=$P($G(^GMPL(125,+GMPLSLST,0)),U) 151 . D EN^VALM("GMPL LIST MENU") 152 F D ADD^GMPL1 Q:$D(GMPQUIT) K DUOUT,DTOUT,GMPSAVED W !!,">>> Please enter another problem, or press <return> to exit." 153 Q 154 ; 155 SETVARS ; -- Define GMP* variables used in ADD and EDIT 156 N VA,VADM,VAEL,VASV,X 157 Q:'DFN D DEM^VADPT,7^VADPT 158 S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID")_$S(VADM(6):U_+VADM(6),1:"") 159 S AUPNSEX=$P(VADM(5),U),GMPVA=1,GMPSC=VAEL(3),GMPAGTOR=VASV(2),GMPION=VASV(3) 160 S X=$P($G(^DPT(DFN,.322)),U,10),GMPGULF=$S(X="Y":1,X="N":0,1:"") 161 S GMPCV=0 I +$G(VASV(10)) S:DT'>$P($G(VASV(10,1)),U) GMPCV=1 ;CV 162 S GMPSHD=+$G(VASV(14,1)) ;SHAD 163 S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT"))),GMPHNC=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"") 164 S X=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),GMPMST=$S(X="Y":1,X="N":0,1:"") 165 S GMPLVIEW("VIEW")=$S($P($G(^SC(+$G(LOC),0)),U,3)="C":"C",1:"S") 166 S GMPCLIN="" I $G(LOC),GMPLVIEW("VIEW")="C" S GMPCLIN=+LOC_U_$P(^SC(+LOC,0),U) 167 S X=$$PARAM,GMPARAM("VER")=+$P(X,U,2),GMPARAM("CLU")=+$P(X,U,4),GMPARAM("REV")=+$P(X,U,5) 168 S:+GMPROV=DUZ GMPLUSER=1 S GMPVAMC=+$G(DUZ(2)),GMPLIST(0)=0 169 Q 170 ; 171 EDIT(DFN,LOC,GMPROV,GMPIFN) ; Interactive LMgr action to edit a problem 172 N GMPARAM,GMPDFN,GMPVA,GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST,GMPCV,GMPSHD 173 N GMPLVIEW,GMPCLIN,GMPLJUMP,GMPQUIT,GMPLUSER,GMPLVAMC,AUPNSEX 174 L +^AUPNPROB(GMPIFN,0):1 I '$T W $C(7),!!,$$LOCKED^GMPLX,! H 2 Q 175 D SETVARS,EN^VALM("GMPL EDIT PROBLEM") 176 L -^AUPNPROB(GMPIFN,0) 177 Q 178 ; 179 REMOVE(GMPIFN,GMPROV,TEXT,PLY) ; -- Remove problem GMPIFN 180 N GMPVAMC,CHANGE 181 S GMPVAMC=+$G(DUZ(2)),PLY=-1,PLY(0)="" 182 I '$L($G(^AUPNPROB(GMPIFN,0))) S PLY(0)="Invalid problem" Q 183 I '$D(^VA(200,+$G(GMPROV),0)) S PLY(0)="Invalid provider" Q 184 I $L($G(TEXT)) S GMPFLD(10,"NEW",1)=TEXT D NEWNOTE^GMPLSAVE 185 S CHANGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_U_$P($G(^AUPNPROB(GMPIFN,1)),U,2)_"^H^Deleted^"_+$G(GMPROV),$P(^AUPNPROB(GMPIFN,1),U,2)="H",PLY=GMPIFN 186 D AUDIT^GMPLX(CHANGE,""),DTMOD^GMPLX(GMPIFN) 187 Q 188 ; 189 PARAM() ; -- Returns parameter values from 125.99 190 Q $G(^GMPL(125.99,1,0)) 191 ; 192 VAF(DFN,SILENT) ; -- print PL VA Form chart copy 193 ; 194 N VA,VADM,VAERR,GMPDFN,GMPVAMC,X,GMPARAM,GMPRT,GMPQUIT,GMPLCURR 195 Q:'$G(DFN) D DEM^VADPT S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID") 196 S GMPVAMC=+$G(DUZ(2)),GMPARAM("QUIET")=1 197 S X=$G(^GMPL(125.99,1,0)),GMPARAM("VER")=+$P(X,U,2),GMPARAM("PRT")=+$P(X,U,3),GMPARAM("CLU")=+$P(X,U,4),GMPARAM("REV")=$S($P(X,U,5)="R":1,1:0) K X 198 D VAF^GMPLPRNT I '$G(SILENT) D Q:$G(GMPQUIT) 199 . I GMPRT'>0 W !!,"No problems available." S GMPQUIT=1 Q 200 . D DEVICE^GMPLPRNT Q:$G(GMPQUIT) D CLEAR^VALM1 201 D PRT^GMPLPRNT 202 Q 1 GMPLUTL2 ; SLC/MKB/KER -- PL Utilities (OE/TIU) ; 04/15/2002 2 ;;2.0;Problem List;**10,18,21,26**;Aug 25, 1994 3 ; 4 ; External References 5 ; DBIA 348 ^DPT( file #2 6 ; DBIA 10082 ^ICD9( file #80 7 ; DBIA 10040 ^SC( file #44 8 ; DBIA 10060 ^VA(200 9 ; DBIA 2716 $$GETSTAT^DGMSTAPI 10 ; DBIA 3457 $$GETCUR^DGNTAPI 11 ; DBIA 10062 7^VADPT 12 ; DBIA 10062 DEM^VADPT 13 ; DBIA 10118 EN^VALM 14 ; DBIA 10116 CLEAR^VALM1 15 ; DBIA 10103 $$HTFM^XLFDT 16 ; 17 LIST(GMPL,GMPDFN,GMPSTAT,GMPCOMM) ; Returns list of Problems for Patient 18 ; 19 ; Input GMPDFN Pointer to Patient file #2 20 ; GMPCOMP Display Comments 1/0 21 ; GMTSTAT Status A/I/"" 22 ; 23 ; Output GMPL Array, passed by reference 24 ; GMPL(#) 25 ; Piece 1: Pointer to Problem #9000011 26 ; 2: Status 27 ; 3: Description 28 ; 4: ICD-9 code 29 ; 5: Date of Onset 30 ; 6: Date Last Modified 31 ; 7: Service Connected 32 ; 8: Special Exposures 33 ; GMPL(#,C#) Comments 34 ; GMPL(0) Number of Problems Returned 35 ; 36 N I,IFN,CNT,GMPL0,GMPL1,SP,ST,NUM,ONSET,ICD,LASTMOD,SC,GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL 37 Q:$G(GMPDFN)'>0 S CNT=0,SP="" 38 S GMPARAM("QUIET")=1,GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R" 39 S GMPLVIEW("ACT")=GMPSTAT,GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 40 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 41 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 42 . S IFN=+GMPLIST(NUM) Q:IFN'>0 43 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),CNT=CNT+1 44 . S ICD=$P($G(^ICD9(+GMPL0,0)),U),LASTMOD=$P(GMPL0,U,3) 45 . S ST=$P(GMPL0,U,12),ONSET=$P(GMPL0,U,13) 46 . S SC=$S(+$P(GMPL1,U,10):"SC",$P(GMPL1,U,10)=0:"NSC",1:"") 47 . N SCS D SCS^GMPLX1(IFN,.SCS) S SP=$G(SCS(3)) 48 . S GMPL(CNT)=IFN_U_ST_U_$$PROBTEXT^GMPLX(IFN)_U_ICD_U_ONSET_U_LASTMOD_U_SC_U_SP_U_$S($P(GMPL1,U,14)="A":"*",1:"")_U_$S('$P($G(^GMPL(125.99,1,0)),U,2):"",$P(GMPL1,U,2)'="T":"",1:"$") 49 . I $G(GMPCOMM) D 50 . . N FAC,NIFN,NOTE,NOTECNT 51 . . S NOTECNT=0,FAC=0 52 . . F S FAC=$O(^AUPNPROB(IFN,11,FAC)) Q:+FAC'>0 D 53 . . . S NIFN=0 54 . . . F S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,NIFN)) Q:NIFN'>0 D 55 . . . . S NOTE=$P($G(^AUPNPROB(IFN,11,FAC,11,NIFN,0)),U,3) 56 . . . . S NOTECNT=NOTECNT+1,GMPL(CNT,NOTECNT)=NOTE 57 S GMPL(0)=CNT 58 Q 59 ; 60 DETAIL(IFN,GMPL) ; Returns Detailed Data for Problem 61 ; 62 ; Input IFN Pointer to Problem file #9000011 63 ; 64 ; Output GMPL Array, passed by reference 65 ; GMPL("DATA NAME") = External Format of Value 66 ; 67 ; GMPL("DIAGNOSIS") ICD Code 68 ; GMPL("PATIENT") Patient Name 69 ; GMPL("MODIFIED") Date Last Modified 70 ; GMPL("NARRATIVE") Provider Narrative 71 ; GMPL("ENTERED") Date Entered ^ Entered by 72 ; GMPL("STATUS") Status 73 ; GMPL("PRIORITY") Priority Acute/Chronic 74 ; GMPL("ONSET") Date of Onset 75 ; GMPL("PROVIDER") Responsible Provider 76 ; GMPL("RECORDED") Date Recorded ^ Recorded by 77 ; GMPL("CLINIC") Hospital Location 78 ; GMPL("SC") Service Connected SC/NSC/"" 79 ; 80 ; GMPL("EXPOSURE") = # 81 ; GMPL("EXPOSURE",X)="AGENT ORANGE" 82 ; GMPL("EXPOSURE",X)="RADIATION" 83 ; GMPL("EXPOSURE",X)="ENV CONTAMINANTS" 84 ; GMPL("EXPOSURE",X)="HEAD AND/OR NECK CANCER" 85 ; GMPL("EXPOSURE",X)="MILITARY SEXUAL TRAUMA" 86 ; 87 ; GMPL("COMMENT") = # 88 ; GMPL("COMMENT",CNT) = Date ^ Author ^ Text of Note 89 ; 90 N GMPL0,GMPL1,GMPLP,X,I,FAC,CNT,NIFN Q:'$D(^AUPNPROB(IFN,0)) 91 S GMPLP=+($$PTR^GMPLUTL4),GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)) 92 S GMPL("DIAGNOSIS")=$P($G(^ICD9(+GMPL0,0)),U) 93 S GMPL("PATIENT")=$P($G(^DPT(+$P(GMPL0,U,2),0)),U) 94 S GMPL("MODIFIED")=$$EXTDT^GMPLX($P(GMPL0,U,3)) 95 S GMPL("NARRATIVE")=$$PROBTEXT^GMPLX(IFN) 96 S GMPL("ENTERED")=$$EXTDT^GMPLX($P(GMPL0,U,8))_U_$P($G(^VA(200,+$P(GMPL1,U,3),0)),U) 97 S X=$P(GMPL0,U,12),GMPL("STATUS")=$S(X="A":"ACTIVE",1:"INACTIVE") 98 S X=$S(X'="A":"",1:$P(GMPL1,U,14)),GMPL("PRIORITY")=$S(X="A":"ACUTE",X="C":"CHRONIC",1:"") 99 S GMPL("ONSET")=$$EXTDT^GMPLX($P(GMPL0,U,13)) 100 S GMPL("PROVIDER")=$P($G(^VA(200,+$P(GMPL1,U,5),0)),U) 101 S GMPL("RECORDED")=$$EXTDT^GMPLX($P(GMPL1,U,9))_U_$P($G(^VA(200,+$P(GMPL1,U,4),0)),U) 102 S GMPL("CLINIC")=$P($G(^SC(+$P(GMPL1,U,8),0)),U) 103 S GMPL("SC")=$S($P(GMPL1,U,10):"YES",$P(GMPL1,U,10)=0:"NO",1:"UNKNOWN") 104 S GMPL("EXPOSURE")=0 105 I $P(GMPL1,U,11) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="AGENT ORANGE",GMPL("EXPOSURE")=X 106 I $P(GMPL1,U,12) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="RADIATION",GMPL("EXPOSURE")=X 107 I $P(GMPL1,U,13) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="ENV CONTAMINANTS",GMPL("EXPOSURE")=X 108 I $P(GMPL1,U,15) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="HEAD AND/OR NECK CANCER",GMPL("EXPOSURE")=X 109 I $P(GMPL1,U,16)&(GMPLP'>0) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="MILITARY SEXUAL TRAUMA",GMPL("EXPOSURE")=X 110 S (FAC,CNT)=0,GMPL("COMMENT")=0 111 F FAC=0:0 S FAC=$O(^AUPNPROB(IFN,11,FAC)) Q:+FAC'>0 D 112 . F NIFN=0:0 S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,NIFN)) Q:NIFN'>0 D 113 . . S X=$G(^AUPNPROB(IFN,11,FAC,11,NIFN,0)) 114 . . S CNT=CNT+1,GMPL("COMMENT",CNT)=$$EXTDT^GMPLX($P(X,U,5))_U_$P($G(^VA(200,+$P(X,U,6),0)),U)_U_$P(X,U,3) 115 S GMPL("COMMENT")=CNT D AUDIT 116 Q 117 ; 118 AUDIT ; 14 Sep 99 - MA - Add audit trail to OE Problem List. 119 ; Called from DETAIL, requires IFN and sets GMPL("AUDIT") 120 N IDT,AIFN,X0,X1,FLD,CNT 121 S CNT=0,GMPL("AUDIT")=CNT 122 F IDT=0:0 S IDT=$O(^GMPL(125.8,"AD",IFN,IDT)) Q:IDT'>0 D 123 . F AIFN=0:0 S AIFN=$O(^GMPL(125.8,"AD",IFN,IDT,AIFN)) Q:AIFN'>0 D 124 .. S X0=$G(^GMPL(125.8,AIFN,0)),X1=$G(^(1)) Q:'$L(X0) 125 .. S FLD=$$FLDNAME(+$P(X0,U,2)) 126 .. S CNT=CNT+1 127 .. S GMPL("AUDIT",CNT,0)=$P(X0,U,2)_U_FLD_U_$P(X0,U,3,8) 128 .. ; = pointer#^fld name^date mod^who mod^old^new^reason^prov 129 .. S:$L(X1) GMPL("AUDIT",CNT,1)=X1 130 S GMPL("AUDIT")=CNT 131 Q 132 ; 133 FLDNAME(NUM) ; Returns field name for display 134 N NAME,NM1,NM2,I,J S J=0,NAME="" 135 S NM1=".01^.05^.12^.13^1.01^1.02^1.04^1.05^1.06^1.07^1.08^1.09^1.1^1.11^1.12^1.13^1.14^1101" 136 F I=1:1:$L(NM1,U) I +$P(NM1,U,I)=+NUM S J=I Q 137 G:J'>0 FNQ 138 S NM2="DIAGNOSIS^PROVIDER NARRATIVE^STATUS^DATE OF ONSET^PROBLEM^CONDITION^RECORDING PROVIDER^RESPONSIBLE PROVIDER^SERVICE^DATE RESOLVED^CLINIC^DATE RECORDED^SERVICE CONNECTED^AGENT ORANGE EXP^RADIATION EXP^ENV CONTAMINANTS EXP^PRIORITY^NOTE" 139 S NAME=$P(NM2,U,J) 140 FNQ Q NAME 141 ; 142 ADD(DFN,LOC,GMPROV) ; -- Interactive LMgr action to add new problem 143 N X,Y,GMPDFN,GMPVA,GMPVAMC,GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST 144 N GMPARAM,GMPLVIEW,GMPLUSER,GMPCLIN,GMPLSLST,GMPQUIT,VALMCC,GMPSAVED 145 Q:'DFN Q:'LOC D SETVARS 146 S GMPLSLST=$P($G(^VA(200,DUZ,125)),U,2),VALMCC=0 147 I 'GMPLSLST,GMPCLIN,$D(^GMPL(125,"C",+GMPCLIN)) S GMPLSLST=$O(^(+GMPCLIN,0)) 148 I GMPLSLST D Q 149 . S $P(GMPLSLST,U,2)=$P($G(^GMPL(125,+GMPLSLST,0)),U) 150 . D EN^VALM("GMPL LIST MENU") 151 F D ADD^GMPL1 Q:$D(GMPQUIT) K DUOUT,DTOUT,GMPSAVED W !!,">>> Please enter another problem, or press <return> to exit." 152 Q 153 ; 154 SETVARS ; -- Define GMP* variables used in ADD and EDIT 155 N VA,VADM,VAEL,VASV,X 156 Q:'DFN D DEM^VADPT,7^VADPT 157 S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID")_$S(VADM(6):U_+VADM(6),1:"") 158 S AUPNSEX=$P(VADM(5),U),GMPVA=1,GMPSC=VAEL(3),GMPAGTOR=VASV(2),GMPION=VASV(3) 159 S X=$P($G(^DPT(DFN,.322)),U,10),GMPGULF=$S(X="Y":1,X="N":0,1:"") 160 S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT"))),GMPHNC=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"") 161 S X=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),GMPMST=$S(X="Y":1,X="N":0,1:"") 162 S GMPLVIEW("VIEW")=$S($P($G(^SC(+$G(LOC),0)),U,3)="C":"C",1:"S") 163 S GMPCLIN="" I $G(LOC),GMPLVIEW("VIEW")="C" S GMPCLIN=+LOC_U_$P(^SC(+LOC,0),U) 164 S X=$$PARAM,GMPARAM("VER")=+$P(X,U,2),GMPARAM("CLU")=+$P(X,U,4),GMPARAM("REV")=+$P(X,U,5) 165 S:+GMPROV=DUZ GMPLUSER=1 S GMPVAMC=+$G(DUZ(2)),GMPLIST(0)=0 166 Q 167 ; 168 EDIT(DFN,LOC,GMPROV,GMPIFN) ; Interactive LMgr action to edit a problem 169 N GMPARAM,GMPDFN,GMPVA,GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST 170 N GMPLVIEW,GMPCLIN,GMPLJUMP,GMPQUIT,GMPLUSER,GMPLVAMC,AUPNSEX 171 L +^AUPNPROB(GMPIFN,0):1 I '$T W $C(7),!!,$$LOCKED^GMPLX,! H 2 Q 172 D SETVARS,EN^VALM("GMPL EDIT PROBLEM") 173 L -^AUPNPROB(GMPIFN,0) 174 Q 175 ; 176 REMOVE(GMPIFN,GMPROV,TEXT,PLY) ; -- Remove problem GMPIFN 177 N GMPVAMC,CHANGE 178 S GMPVAMC=+$G(DUZ(2)),PLY=-1,PLY(0)="" 179 I '$L($G(^AUPNPROB(GMPIFN,0))) S PLY(0)="Invalid problem" Q 180 I '$D(^VA(200,+$G(GMPROV),0)) S PLY(0)="Invalid provider" Q 181 I $L($G(TEXT)) S GMPFLD(10,"NEW",1)=TEXT D NEWNOTE^GMPLSAVE 182 S CHANGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_U_$P($G(^AUPNPROB(GMPIFN,1)),U,2)_"^H^Deleted^"_+$G(GMPROV),$P(^AUPNPROB(GMPIFN,1),U,2)="H",PLY=GMPIFN 183 D AUDIT^GMPLX(CHANGE,""),DTMOD^GMPLX(GMPIFN) 184 Q 185 ; 186 PARAM() ; -- Returns parameter values from 125.99 187 Q $G(^GMPL(125.99,1,0)) 188 ; 189 VAF(DFN,SILENT) ; -- print PL VA Form chart copy 190 ; 191 N VA,VADM,VAERR,GMPDFN,GMPVAMC,X,GMPARAM,GMPRT,GMPQUIT,GMPLCURR 192 Q:'$G(DFN) D DEM^VADPT S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID") 193 S GMPVAMC=+$G(DUZ(2)),GMPARAM("QUIET")=1 194 S X=$G(^GMPL(125.99,1,0)),GMPARAM("VER")=+$P(X,U,2),GMPARAM("PRT")=+$P(X,U,3),GMPARAM("CLU")=+$P(X,U,4),GMPARAM("REV")=$S($P(X,U,5)="R":1,1:0) K X 195 D VAF^GMPLPRNT I '$G(SILENT) D Q:$G(GMPQUIT) 196 . I GMPRT'>0 W !!,"No problems available." S GMPQUIT=1 Q 197 . D DEVICE^GMPLPRNT Q:$G(GMPQUIT) D CLEAR^VALM1 198 D PRT^GMPLPRNT 199 Q -
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLX1.m
r613 r623 1 GMPLX1 ; SLC/MKB/KER -- Problem List Person Utilities ; 04/15/2002 2 ;;2.0;Problem List;**3,26,35**;Aug 25, 1994;Build 26 3 ; 4 ; External References 5 ; DBIA 348 ^DPT( 6 ; DBIA 3106 ^DIC(49 7 ; DBIA 872 ^ORD(101 8 ; DBIA 10060 ^VA(200 9 ; DBIA 10062 7^VADPT 10 ; DBIA 10062 DEM^VADPT 11 ; DBIA 2716 $$GETSTAT^DGMSTAPI 12 ; DBIA 3457 $$GETCUR^DGNTAPI 13 ; DBIA 10104 $$REPEAT^XLFSTR 14 ; DBIA 10006 ^DIC 15 ; DBIA 10018 ^DIE 16 ; DBIA 10026 ^DIR 17 ; 18 PAT() ; Select patient -- returns DFN^NAME^BID 19 N DIC,X,Y,DFN,VADM,VA,PAT 20 P1 S DIC="^AUPNPAT(",DIC(0)="AEQM" D ^DIC I +Y<1 Q -1 21 I $P(Y,U,2)'=$P(^DPT(+Y,0),U) W $C(7),!!,"ERROR -- Please check your Patient Files #2 and #9000001 for inconsistencies.",! G P1 22 S DFN=+Y,PAT=Y D DEM^VADPT 23 S PAT=PAT_U_$E($P(PAT,U,2))_VA("BID"),AUPNSEX=$P(VADM(5),U) 24 I VADM(6) S PAT=PAT_U_+VADM(6) ; date of death 25 Q PAT 26 ; 27 VADPT(DFN) ; Get Service/Elig Flags 28 ; 29 ; Returns = 1/0/"" if Y/N/unknown 30 ; GMPSC Service Connected 31 ; GMPAGTOR Agent Orange Exposure 32 ; GMPION Ionizing Radiation Exposure 33 ; GMPGULF Persian Gulf Exposure 34 ; GMPMST Military Sexual Trauma 35 ; GMPHNC Head and/or Neck Cancer 36 ; GMPCV Combat Veteran 37 ; GMPSHD Shipboard Hazard and Defense 38 ; 39 N VAEL,VASV,VAERR,HNC,X D 7^VADPT S GMPSC=VAEL(3),GMPAGTOR=VASV(2) 40 S GMPION=VASV(3),X=$P($G(^DPT(DFN,.322)),U,10),GMPGULF=$S(X="Y":1,X="N":0,1:"") 41 S GMPCV=0 I +$G(VASV(10)) S:DT'>$P($G(VASV(10,1)),U) GMPCV=1 ;CV 42 S GMPSHD=+$G(VASV(14,1)) ;SHAD 43 S X=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),GMPMST=$S(X="Y":1,X="N":0,1:"") 44 S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT"))),GMPHNC=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"") 45 Q 46 SCS(PROB,SC) ; Get Exposure/Conditions Strings 47 ; 48 ; Input PROB Pointer to Problem #9000011 49 ; 50 ; Returns SC Array passed by reference 51 ; SC(1)="AO/IR/EC/HNC/MST/CV/SHD" 52 ; SC(2)="A/I/E/H/M/C/S" 53 ; SC(3)="AIEHMCS" 54 ; 55 ; NOTE: Military Sexual Trauma (MST) is suppressed 56 ; if the current device is a printer. 57 ; 58 N ND,DA,FL,AO,IR,EC,HNC,MST,PTR S DA=+($G(PROB)) Q:+DA=0 59 S ND=$G(^AUPNPROB(+DA,1)),AO=+($P(ND,"^",11)),IR=+($P(ND,"^",12)) 60 S EC=+($P(ND,"^",13)),HNC=+($P(ND,"^",15)),MST=+($P(ND,"^",16)) 61 S CV=+($P(ND,"^",17)),SHD=+($P(ND,"^",18)) 62 S PTR=$$PTR^GMPLUTL4 63 I +AO>0 D 64 . S:$G(SC(1))'["AO" SC(1)=$G(SC(1))_"/AO" S:$G(SC(2))'["A" SC(2)=$G(SC(2))_"/A" S:$G(SC(3))'["A" SC(3)=$G(SC(3))_"A" 65 I +IR>0 D 66 . S:$G(SC(1))'["IR" SC(1)=$G(SC(1))_"/IR" S:$G(SC(2))'["I" SC(2)=$G(SC(2))_"/I" S:$G(SC(3))'["I" SC(3)=$G(SC(3))_"I" 67 I +EC>0 D 68 . S:$G(SC(1))'["EC" SC(1)=$G(SC(1))_"/EC" S:$G(SC(2))'["E" SC(2)=$G(SC(2))_"/E" S:$G(SC(3))'["E" SC(3)=$G(SC(3))_"E" 69 I +HNC>0 D 70 . S:$G(SC(1))'["HNC" SC(1)=$G(SC(1))_"/HNC" S:$G(SC(2))'["H" SC(2)=$G(SC(2))_"/H" S:$G(SC(3))'["H" SC(3)=$G(SC(3))_"H" 71 I +MST>0 D 72 . S:$G(SC(1))'["MST" SC(1)=$G(SC(1))_"/MST" S:$G(SC(2))'["M" SC(2)=$G(SC(2))_"/M" S:$G(SC(3))'["M" SC(3)=$G(SC(3))_"M" 73 I +CV>0 D 74 . S:$G(SC(1))'["CV" SC(1)=$G(SC(1))_"/CV" S:$G(SC(2))'["C" SC(2)=$G(SC(2))_"/C" S:$G(SC(3))'["C" SC(3)=$G(SC(3))_"C" 75 I +PTR'>0 D 76 . I +SHD>0 S:$G(SC(1))'["SHD" SC(1)=$G(SC(1))_"/SHD" S:$G(SC(2))'["D" SC(2)=$G(SC(2))_"/S" S:$G(SC(3))'["S" SC(3)=$G(SC(3))_"S" 77 S:$D(SC(1)) SC(1)=$$RS(SC(1)) S:$D(SC(2)) SC(2)=$$RS(SC(2)) 78 Q 79 SCCOND(DFN,SC) ; Get Service/Elig Flags (array) 80 ; Returns local array .SC passed by value 81 N HNC,VAEL,VASV,VAERR,X D 7^VADPT 82 S SC("DFN")=$G(DFN),SC("SC")=$P(VAEL(3),"^",1) 83 S SC("AO")=$P(VASV(2),"^",1) 84 S SC("IR")=$P(VASV(3),"^",1) 85 S X=$P($G(^DPT(DFN,.322)),U,10),SC("PG")=$S(X="Y":1,X="N":0,1:"") 86 S SC("CV")=0 I +$G(VASV(10)) S:DT'>$P($G(VASV(10,1)),U) SC("CV")=1 ;CV 87 S SC("SHD")=+$G(VASV(14,1)) ;SHAD 88 S X=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),SC("MST")=$S(X="Y":1,X="N":0,1:"") 89 S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT"))),SC("HNC")=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"") 90 Q 91 ; 92 CKDEAD(DATE) ; Dead patient ... continue? Returns 1 if YES, 0 otherwise 93 N DIR,X,Y S DIR(0)="YA",DIR("B")="NO" 94 S DIR("A")="Are you sure you want to continue? " 95 S DIR("?",1)=" Enter YES to continue and add new problem(s) for this patient:",DIR("?")=" press <return> to select another action." 96 W $C(7),!!,"DATE OF DEATH: "_$$EXTDT^GMPLX(DATE) 97 D ^DIR 98 Q +Y 99 ; 100 REQPROV() ; Returns requesting provider 101 N DIR,X,Y 102 I $D(GMPLUSER) S Y=DUZ_U_$P(^VA(200,DUZ,0),U) Q Y 103 S DIR("?")="Enter the name of the provider responsible for this data." 104 S DIR(0)="PA^200:AEQM",DIR("A")="Provider: " 105 S:$G(GMPROV) DIR("B")=$P(GMPROV,U,2) W ! D ^DIR 106 I $D(DUOUT)!($D(DTOUT))!(+Y'>0) Q -1 107 Q Y 108 ; 109 NAME(USER) ; Formats user name into "Lastname,F" 110 N NAME,LAST,FIRST 111 S NAME=$P($G(^VA(200,+USER,0)),U) I '$L(NAME) Q "" 112 S LAST=$P(NAME,","),FIRST=$P(NAME,",",2) 113 S:$E(FIRST)=" " FIRST=$E(FIRST,2,99) 114 Q $E(LAST,1,15)_","_$E(FIRST) 115 ; 116 SERVICE(USER) ; Returns User's service/section from file #49 117 N X S X=+$P($G(^VA(200,USER,5)),U) 118 I $P($G(^DIC(49,X,0)),U,9)'="C" S X=0 119 S:X>0 X=X_U_$P($G(^DIC(49,X,0)),U) S:X'>0 X="" 120 Q X 121 ; 122 SERV(X) ; Return service name abbreviation 123 N NODE,ABBREV 124 S NODE=$G(^DIC(49,+X,0)) I NODE="" Q "" 125 S ABBREV=$P(NODE,U,2) I ABBREV="" S ABBREV=$E($P(NODE,U),1,4) 126 Q ABBREV_"/" 127 ; 128 CLINIC(LAST) ; Returns clinic from file #44 129 N X,Y,DIC,DIR S Y="" G:$E(GMPLVIEW("VIEW"))="S" CLINQ 130 S DIR(0)="FAO^1:30",DIR("A")="Clinic: " S:$L(LAST) DIR("B")=$P(LAST,U,2) 131 S DIR("?")="Enter the clinic to be associated with these problems, if available" 132 S DIR("??")="^D LISTCLIN^GMPLMGR1 W !,DIR(""?"")_"".""" 133 CLIN1 ; Ask Clinic 134 D ^DIR S:$D(DUOUT)!($D(DTOUT)) Y="^" S:Y="@" Y="" G:("^"[Y) CLINQ 135 S DIC="^SC(",DIC(0)="EMQ",DIC("S")="I $P(^(0),U,3)=""C""" 136 D ^DIC I Y'>0 W !?5,"Only clinics are allowed!",! G CLIN1 137 CLINQ ; Quit Asking 138 Q Y 139 ; 140 VIEW(USER) ; Returns user's preferred view 141 N X S X=$P($G(^VA(200,USER,125)),U) 142 Q X 143 ; 144 VOCAB() ; Select search vocabulary 145 N DIR,X,Y S DIR(0)="SAOM^N:NURSING;I:IMMUNOLOGIC;D:DENTAL;S:SOCIAL WORK;P:GENERAL PROBLEM" 146 S DIR("A")="Select Specialty Subset: ",DIR("B")="GENERAL PROBLEM" 147 S DIR("?",1)="Because many discipline-specific terms are synonyms to other terms," 148 S DIR("?",2)="they are not accessible unless you specify the appropriate subset of the" 149 S DIR("?",3)="Clinical Lexicon to select from. Choose from: Nursing" 150 S DIR("?",4)=$$REPEAT^XLFSTR(" ",48)_"Immunologic" 151 S DIR("?",5)=$$REPEAT^XLFSTR(" ",48)_"Dental" 152 S DIR("?",6)=$$REPEAT^XLFSTR(" ",48)_"Social Work" 153 S DIR("?")=$$REPEAT^XLFSTR(" ",48)_"General Problem" 154 D ^DIR S X=$S(Y="N":"NUR",Y="I":"IMM",Y="D":"DEN",Y="S":"SOC",Y="P":"PL1",1:"^") 155 Q X 156 ; 157 PARAMS ; Edit pkg parameters in file #125.99 158 N DIE,DA,DR,OLDVERFY,VERFY,BLANK S BLANK=" " 159 S OLDVERFY=+$P($G(^GMPL(125.99,1,0)),U,2) 160 S DIE="^GMPL(125.99,",DA=1,DR="1:6" D ^DIE 161 Q:+$P($G(^GMPL(125.99,1,0)),U,2)=OLDVERFY 162 S DA(1)=$O(^ORD(101,"B","GMPL PROBLEM LIST",0)) Q:'DA(1) 163 S VERFY=$O(^ORD(101,"B","GMPL VERIFY",0)) W "." 164 S DA=$O(^ORD(101,DA(1),10,"B",VERFY,0)) Q:'DA 165 S DR=$S(OLDVERFY:"2///@;6///^S X=BLANK",1:"2////$;6///@") W "." 166 S DIE="^ORD(101,"_DA(1)_",10," 167 D ^DIE W "." 168 Q 169 RS(X) ; Remove Slashes 170 S X=$G(X) F Q:$E(X,1)'="/" S X=$E(X,2,$L(X)) 171 F Q:$E(X,$L(X))'="/" S X=$E(X,1,($L(X)-1)) 172 Q X 1 GMPLX1 ; SLC/MKB/KER -- Problem List Person Utilities ; 04/15/2002 2 ;;2.0;Problem List;**3,26**;Aug 25, 1994 3 ; 4 ; External References 5 ; DBIA 348 ^DPT( 6 ; DBIA 3106 ^DIC(49 7 ; DBIA 872 ^ORD(101 8 ; DBIA 10060 ^VA(200 9 ; DBIA 10062 7^VADPT 10 ; DBIA 10062 DEM^VADPT 11 ; DBIA 2716 $$GETSTAT^DGMSTAPI 12 ; DBIA 3457 $$GETCUR^DGNTAPI 13 ; DBIA 10104 $$REPEAT^XLFSTR 14 ; DBIA 10006 ^DIC 15 ; DBIA 10018 ^DIE 16 ; DBIA 10026 ^DIR 17 ; 18 PAT() ; Select patient -- returns DFN^NAME^BID 19 N DIC,X,Y,DFN,VADM,VA,PAT 20 P1 S DIC="^AUPNPAT(",DIC(0)="AEQM" D ^DIC I +Y<1 Q -1 21 I $P(Y,U,2)'=$P(^DPT(+Y,0),U) W $C(7),!!,"ERROR -- Please check your Patient Files #2 and #9000001 for inconsistencies.",! G P1 22 S DFN=+Y,PAT=Y D DEM^VADPT 23 S PAT=PAT_U_$E($P(PAT,U,2))_VA("BID"),AUPNSEX=$P(VADM(5),U) 24 I VADM(6) S PAT=PAT_U_+VADM(6) ; date of death 25 Q PAT 26 ; 27 VADPT(DFN) ; Get Service/Elig Flags 28 ; 29 ; Returns = 1/0/"" if Y/N/unknown 30 ; GMPSC Service Connected 31 ; GMPAGTOR Agent Orange Exposure 32 ; GMPION Ionizing Radiation Exposure 33 ; GMPGULF Persian Gulf Exposure 34 ; GMPMST Military Sexual Trauma 35 ; GMPHNC Head and/or Neck Cancer 36 ; 37 N VAEL,VASV,VAERR,HNC,X D 7^VADPT S GMPSC=VAEL(3),GMPAGTOR=VASV(2) 38 S GMPION=VASV(3),X=$P($G(^DPT(DFN,.322)),U,10),GMPGULF=$S(X="Y":1,X="N":0,1:"") 39 S X=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),GMPMST=$S(X="Y":1,X="N":0,1:"") 40 S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT"))),GMPHNC=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"") 41 Q 42 SCS(PROB,SC) ; Get Exposure/Conditions Strings 43 ; 44 ; Input PROB Pointer to Problem #9000011 45 ; 46 ; Returns SC Array passed by reference 47 ; SC(1)="AO/IR/EC/HNC/MST" 48 ; SC(2)="A/I/E/H/M" 49 ; SC(3)="AIEHM" 50 ; 51 ; NOTE: Military Sexual Trauma (MST) is suppressed 52 ; if the current device is a printer. 53 ; 54 N ND,DA,FL,AO,IR,EC,HNC,MST,PTR S DA=+($G(PROB)) Q:+DA=0 55 S ND=$G(^AUPNPROB(+DA,1)),AO=+($P(ND,"^",11)),IR=+($P(ND,"^",12)) 56 S EC=+($P(ND,"^",13)),HNC=+($P(ND,"^",15)),MST=+($P(ND,"^",16)) 57 S PTR=$$PTR^GMPLUTL4 58 I +AO>0 D 59 . S:$G(SC(1))'["AO" SC(1)=$G(SC(1))_"/AO" S:$G(SC(2))'["A" SC(2)=$G(SC(2))_"/A" S:$G(SC(3))'["A" SC(3)=$G(SC(3))_"A" 60 I +IR>0 D 61 . S:$G(SC(1))'["IR" SC(1)=$G(SC(1))_"/IR" S:$G(SC(2))'["I" SC(2)=$G(SC(2))_"/I" S:$G(SC(3))'["I" SC(3)=$G(SC(3))_"I" 62 I +EC>0 D 63 . S:$G(SC(1))'["EC" SC(1)=$G(SC(1))_"/EC" S:$G(SC(2))'["E" SC(2)=$G(SC(2))_"/E" S:$G(SC(3))'["E" SC(3)=$G(SC(3))_"E" 64 I +HNC>0 D 65 . S:$G(SC(1))'["HNC" SC(1)=$G(SC(1))_"/HNC" S:$G(SC(2))'["H" SC(2)=$G(SC(2))_"/H" S:$G(SC(3))'["H" SC(3)=$G(SC(3))_"H" 66 I +PTR'>0 D 67 . I +MST>0 S:$G(SC(1))'["MST" SC(1)=$G(SC(1))_"/MST" S:$G(SC(2))'["M" SC(2)=$G(SC(2))_"/M" S:$G(SC(3))'["M" SC(3)=$G(SC(3))_"M" 68 S:$D(SC(1)) SC(1)=$$RS(SC(1)) S:$D(SC(2)) SC(2)=$$RS(SC(2)) 69 Q 70 SCCOND(DFN,SC) ; Get Service/Elig Flags (array) 71 ; Returns local array .SC passed by value 72 N HNC,VAEL,VASV,VAERR,X D 7^VADPT 73 S SC("DFN")=$G(DFN),SC("SC")=$P(VAEL(3),"^",1) 74 S SC("AO")=$P(VASV(2),"^",1) 75 S SC("IR")=$P(VASV(3),"^",1) 76 S X=$P($G(^DPT(DFN,.322)),U,10),SC("PG")=$S(X="Y":1,X="N":0,1:"") 77 S X=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),SC("MST")=$S(X="Y":1,X="N":0,1:"") 78 S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT"))),SC("HNC")=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"") 79 Q 80 ; 81 CKDEAD(DATE) ; Dead patient ... continue? Returns 1 if YES, 0 otherwise 82 N DIR,X,Y S DIR(0)="YA",DIR("B")="NO" 83 S DIR("A")="Are you sure you want to continue? " 84 S DIR("?",1)=" Enter YES to continue and add new problem(s) for this patient:",DIR("?")=" press <return> to select another action." 85 W $C(7),!!,"DATE OF DEATH: "_$$EXTDT^GMPLX(DATE) 86 D ^DIR 87 Q +Y 88 ; 89 REQPROV() ; Returns requesting provider 90 N DIR,X,Y 91 I $D(GMPLUSER) S Y=DUZ_U_$P(^VA(200,DUZ,0),U) Q Y 92 S DIR("?")="Enter the name of the provider responsible for this data." 93 S DIR(0)="PA^200:AEQM",DIR("A")="Provider: " 94 S:$G(GMPROV) DIR("B")=$P(GMPROV,U,2) W ! D ^DIR 95 I $D(DUOUT)!($D(DTOUT))!(+Y'>0) Q -1 96 Q Y 97 ; 98 NAME(USER) ; Formats user name into "Lastname,F" 99 N NAME,LAST,FIRST 100 S NAME=$P($G(^VA(200,+USER,0)),U) I '$L(NAME) Q "" 101 S LAST=$P(NAME,","),FIRST=$P(NAME,",",2) 102 S:$E(FIRST)=" " FIRST=$E(FIRST,2,99) 103 Q $E(LAST,1,15)_","_$E(FIRST) 104 ; 105 SERVICE(USER) ; Returns User's service/section from file #49 106 N X S X=+$P($G(^VA(200,USER,5)),U) 107 I $P($G(^DIC(49,X,0)),U,9)'="C" S X=0 108 S:X>0 X=X_U_$P($G(^DIC(49,X,0)),U) S:X'>0 X="" 109 Q X 110 ; 111 SERV(X) ; Return service name abbreviation 112 N NODE,ABBREV 113 S NODE=$G(^DIC(49,+X,0)) I NODE="" Q "" 114 S ABBREV=$P(NODE,U,2) I ABBREV="" S ABBREV=$E($P(NODE,U),1,4) 115 Q ABBREV_"/" 116 ; 117 CLINIC(LAST) ; Returns clinic from file #44 118 N X,Y,DIC,DIR S Y="" G:$E(GMPLVIEW("VIEW"))="S" CLINQ 119 S DIR(0)="FAO^1:30",DIR("A")="Clinic: " S:$L(LAST) DIR("B")=$P(LAST,U,2) 120 S DIR("?")="Enter the clinic to be associated with these problems, if available" 121 S DIR("??")="^D LISTCLIN^GMPLMGR1 W !,DIR(""?"")_"".""" 122 CLIN1 ; Ask Clinic 123 D ^DIR S:$D(DUOUT)!($D(DTOUT)) Y="^" S:Y="@" Y="" G:("^"[Y) CLINQ 124 S DIC="^SC(",DIC(0)="EMQ",DIC("S")="I $P(^(0),U,3)=""C""" 125 D ^DIC I Y'>0 W !?5,"Only clinics are allowed!",! G CLIN1 126 CLINQ ; Quit Asking 127 Q Y 128 ; 129 VIEW(USER) ; Returns user's preferred view 130 N X S X=$P($G(^VA(200,USER,125)),U) 131 Q X 132 ; 133 VOCAB() ; Select search vocabulary 134 N DIR,X,Y S DIR(0)="SAOM^N:NURSING;I:IMMUNOLOGIC;D:DENTAL;S:SOCIAL WORK;P:GENERAL PROBLEM" 135 S DIR("A")="Select Specialty Subset: ",DIR("B")="GENERAL PROBLEM" 136 S DIR("?",1)="Because many discipline-specific terms are synonyms to other terms," 137 S DIR("?",2)="they are not accessible unless you specify the appropriate subset of the" 138 S DIR("?",3)="Clinical Lexicon to select from. Choose from: Nursing" 139 S DIR("?",4)=$$REPEAT^XLFSTR(" ",48)_"Immunologic" 140 S DIR("?",5)=$$REPEAT^XLFSTR(" ",48)_"Dental" 141 S DIR("?",6)=$$REPEAT^XLFSTR(" ",48)_"Social Work" 142 S DIR("?")=$$REPEAT^XLFSTR(" ",48)_"General Problem" 143 D ^DIR S X=$S(Y="N":"NUR",Y="I":"IMM",Y="D":"DEN",Y="S":"SOC",Y="P":"PL1",1:"^") 144 Q X 145 ; 146 PARAMS ; Edit pkg parameters in file #125.99 147 N DIE,DA,DR,OLDVERFY,VERFY,BLANK S BLANK=" " 148 S OLDVERFY=+$P($G(^GMPL(125.99,1,0)),U,2) 149 S DIE="^GMPL(125.99,",DA=1,DR="1:6" D ^DIE 150 Q:+$P($G(^GMPL(125.99,1,0)),U,2)=OLDVERFY 151 S DA(1)=$O(^ORD(101,"B","GMPL PROBLEM LIST",0)) Q:'DA(1) 152 S VERFY=$O(^ORD(101,"B","GMPL VERIFY",0)) W "." 153 S DA=$O(^ORD(101,DA(1),10,"B",VERFY,0)) Q:'DA 154 S DR=$S(OLDVERFY:"2///@;6///^S X=BLANK",1:"2////$;6///@") W "." 155 S DIE="^ORD(101,"_DA(1)_",10," 156 D ^DIE W "." 157 Q 158 RS(X) ; Remove Slashes 159 S X=$G(X) F Q:$E(X,1)'="/" S X=$E(X,2,$L(X)) 160 F Q:$E(X,$L(X))'="/" S X=$E(X,1,($L(X)-1)) 161 Q X
Note:
See TracChangeset
for help on using the changeset viewer.
