Changeset 623 for WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLDISP.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
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
Note:
See TracChangeset
for help on using the changeset viewer.