1 | GMTSPLST ; SLC/JER,KER - Problem List ; 04/15/2002
|
---|
2 | ;;2.7;Health Summary;**28,35,52**;Oct 20, 1995
|
---|
3 | ;
|
---|
4 | ; External References
|
---|
5 | ; DBIA 10011 ^DIWP
|
---|
6 | ; DBIA 1183 GETLIST^GMPLHS
|
---|
7 | ; DBIA 1573 $$DSMONE^LEXU
|
---|
8 | ;
|
---|
9 | ; Variable NEWed/KILLed Elsewhere
|
---|
10 | ; DFN, GMPXICDF, GMPXNARR, GMTSNPG, GMTSQIT
|
---|
11 | ;
|
---|
12 | ACTIVE ; Get Active Problems
|
---|
13 | N STATUS S STATUS="A" D MAIN Q
|
---|
14 | INACT ; Get Inactive Problems
|
---|
15 | N STATUS S STATUS="I" D MAIN Q
|
---|
16 | ALL ; Get All Problems (Active and Inactive)
|
---|
17 | N STATUS S STATUS="ALL" D MAIN Q
|
---|
18 | MAIN ; Driver
|
---|
19 | D GETLIST^GMPLHS(DFN,STATUS) Q:'$D(^TMP("GMPLHS",$J)) D SUBHDR D WRT K ^TMP("GMPLHS",$J) Q
|
---|
20 | ;
|
---|
21 | WRT ; Writes Problem List Component,X
|
---|
22 | ;
|
---|
23 | ; ^TMP("GMPLHS",$J,#,0)=
|
---|
24 | ; Piece 1: Diagnosis
|
---|
25 | ; 2: Date Last Modified
|
---|
26 | ; 3: Site
|
---|
27 | ; 4: Date Entered
|
---|
28 | ; 5: Status
|
---|
29 | ; 6: Date of Onset
|
---|
30 | ; 7: Responsible Provider
|
---|
31 | ; 8: Service
|
---|
32 | ; 9: Service Abbreviation
|
---|
33 | ; 10: Date Resolved
|
---|
34 | ; 11: Clinic
|
---|
35 | ; 12: Date Recorded
|
---|
36 | ; 13: Problem - Lexicon Term
|
---|
37 | ; 14: Exposure Combined String
|
---|
38 | ;
|
---|
39 | ; ^TMP("GMPLHS",$J,#,"L") Lexicon Term
|
---|
40 | ; ^TMP("GMPLHS",$J,#,"N") Provider Narrative
|
---|
41 | ; ^TMP("GMPLHS",$J,#,"C",LOC,#,0)) Comments
|
---|
42 | ;
|
---|
43 | N GMREC,GMTSICL,GMTAB,LINE1,DIWL
|
---|
44 | S GMTSICL=32,DIWL=0,GMTAB=0,GMREC=0
|
---|
45 | F S GMREC=$O(^TMP("GMPLHS",$J,GMREC)) Q:GMREC'>0 D Q:$D(GMTSQIT)
|
---|
46 | . N GMNODE,GMDIAG,GMDIAC,GMDIAT,GMDIAS,LASTMDT,STAT,ONSETDT,PROV,SERV
|
---|
47 | . N RESDT,NARR,GMICD,GMDSM,GMDSMS,CODE,LEXI,LEX,PLIFN,ADDINFO,EXP,GMTSX,X
|
---|
48 | . S GMNODE=$G(^TMP("GMPLHS",$J,GMREC,0))
|
---|
49 | . Q:GMNODE']""
|
---|
50 | . S GMDIAG=$P(GMNODE,U),LASTMDT=$P(GMNODE,U,2),STAT=$P(GMNODE,U,5)
|
---|
51 | . S X=LASTMDT D REGDT4^GMTSU S LASTMDT=X
|
---|
52 | . S ONSETDT=$P(GMNODE,U,6),PROV=$P(GMNODE,U,7)
|
---|
53 | . S RESDT=$P(GMNODE,U,10),GMICD=""
|
---|
54 | . S EXP=$P(GMNODE,U,14) S:$L(EXP) EXP=" ("_EXP_")"
|
---|
55 | . I STAT="A",+ONSETDT S X=ONSETDT D REGDT4^GMTSU S ADDINFO="Onset "_X
|
---|
56 | . I STAT="I",+RESDT S X=RESDT D REGDT4^GMTSU S ADDINFO="Resolved "_X
|
---|
57 | . S NARR=""
|
---|
58 | . S:$G(GMPXNARR)'="N" NARR=$G(^TMP("GMPLHS",$J,GMREC,"N"))
|
---|
59 | . I $G(GMPXICDF)]"",$G(GMPXICDF)'="N",GMDIAG]"" D
|
---|
60 | . . D GETICDDX^GMTSPXU1(.GMDIAG,$G(GMPXICDF)) S GMICD=GMDIAG
|
---|
61 | . S GMDIAC=$P($G(GMICD),"-",1),GMDIAT=$P($G(GMICD),"-",2,299)
|
---|
62 | . S LEX=$G(^TMP("GMPLHS",$J,GMREC,"L"))
|
---|
63 | . S LEXI=+LEX,LEX=$P(LEX,"^",2) S:$$UP(LEX)["UNRESOLVED"!(+LEXI'>1) (LEXI,LEX)=""
|
---|
64 | . S (CODE,GMDIAS,GMDSMS,GMDSM)="" S:+LEXI>0 GMDSM=$$DSMONE^LEXU(+LEXI)
|
---|
65 | . S:GMDIAC["799.9" GMDSM=""
|
---|
66 | . S:$L(GMDSM)>2&(GMDSM'[".") GMDSM=GMDSM_"."
|
---|
67 | . S:$L(GMDIAC) GMDIAS="(ICD "_GMDIAC_")"
|
---|
68 | . S:$L(GMDSM) GMDSMS="(DSM "_GMDSM_")"
|
---|
69 | . S:$L(GMDIAC)&($L(GMDSM))&(GMDIAC=GMDSM) GMDIAS="(ICD/DSM "_GMDIAC_")",GMDSMS=""
|
---|
70 | . S:$L(GMDIAS) CODE=GMDIAS S:$L(GMDSMS) CODE=CODE_" "_GMDSMS F Q:$E(CODE,1)'=" " S CODE=$E(CODE,2,$L(CODE))
|
---|
71 | . S:$L(LEX)&($L(CODE)) LEX=LEX_" "_CODE
|
---|
72 | . S:$L(GMDIAT)&($L(CODE)) GMICD=GMDIAT_" "_CODE
|
---|
73 | . ; Unresolved or Unspecified
|
---|
74 | . I GMDIAC["799.9",$L($G(NARR)) D
|
---|
75 | . . N UNARR S UNARR=$$UP(NARR)
|
---|
76 | . . I UNARR["UNKNOWN AND UNSPECIFIED"!(UNARR["UNKNOWN OR UNSPECIFIED")!(UNARR["MORBIDITY OR MORTALITY") D Q
|
---|
77 | . . . S GMICD=GMDIAT_" "_CODE,NARR=""
|
---|
78 | . . S GMICD=$$UP($E(NARR,1))_$E(NARR,2,$L(NARR))_" "_CODE
|
---|
79 | . . S:$L(LEX) GMICD=LEX S NARR=""
|
---|
80 | . ; Specified by Lexicon
|
---|
81 | . I GMDIAC'["799.9",$L($G(LEX)) D
|
---|
82 | . . S GMICD=LEX,NARR=""
|
---|
83 | . ; Specified by Provider Narrative
|
---|
84 | . I GMDIAC'["799.9",'$L($G(LEX)) D
|
---|
85 | . . S:$L(NARR)&($$UP(GMDIAT)'=$$UP(NARR)) GMICD=GMICD_"; "_NARR S NARR=""
|
---|
86 | . S:$G(IOST)["P-"&(EXP["MST") EXT=$$RM(EXP)
|
---|
87 | . S:$L(GMICD)&($L(EXP)) GMICD=GMICD_EXP
|
---|
88 | . S:$L(GMICD) GMICD=GMICD_$S($G(ADDINFO)]"":", "_ADDINFO,1:""),NARR=""
|
---|
89 | . S GMICD=$$RF(GMICD)
|
---|
90 | . D TXTFMT^GMTSPXU1(GMICD,$G(NARR),GMTSICL,GMTAB,DIWL)
|
---|
91 | . I '$D(^UTILITY($J,"W")) Q
|
---|
92 | . S GMTSX=0,LINE1=1
|
---|
93 | . F S GMTSX=$O(^UTILITY($J,"W",DIWL,GMTSX)) Q:GMTSX'>0!$D(GMTSQIT) D
|
---|
94 | . . D:LINE1 L1 D:'LINE1 LN S LINE1=0
|
---|
95 | . D DC
|
---|
96 | . D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG SUBHDR2 W !
|
---|
97 | Q
|
---|
98 | L1 ; Line #1 Problem, date, provider
|
---|
99 | D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG SUBHDR2 W:STATUS="ALL" STAT W ?3,$G(^UTILITY($J,"W",DIWL,GMTSX,0)),?53,LASTMDT,?65,$E(PROV,1,15),! Q
|
---|
100 | LN ; Line >1 Problem (other)
|
---|
101 | D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG SUBHDR2 W ?3,$G(^UTILITY($J,"W",DIWL,GMTSX,0)),! Q
|
---|
102 | ;
|
---|
103 | DC ; Comments are displayed if there are any
|
---|
104 | N LOC,GMR,NODE,DATE,X,UCNT,CNT,CMT,T,I S LOC="",CNT=0
|
---|
105 | F S LOC=$O(^TMP("GMPLHS",$J,GMREC,"C",LOC)) Q:LOC']"" D Q:$D(GMTSQIT)
|
---|
106 | . S (CNT,UCNT)=0 S:+($O(^TMP("GMPLHS",$J,GMREC,"C",LOC," "),-1))>1 UCNT=1
|
---|
107 | . S GMR=0 F S GMR=$O(^TMP("GMPLHS",$J,GMREC,"C",LOC,GMR)) Q:+GMR'>0 D Q:$D(GMTSQIT)
|
---|
108 | . . S NODE=$G(^TMP("GMPLHS",$J,GMREC,"C",LOC,GMR,0)) Q:NODE']""
|
---|
109 | . . S CMT=$P(NODE,U) I $L($G(CMT)) D LC
|
---|
110 | Q
|
---|
111 | LC ; List Comments (unnumbered and numbered)
|
---|
112 | S CNT=CNT+1 K ^UTILITY($J,"W") D:UCNT CF(CNT,CMT) D:'UCNT CF(0,CMT)
|
---|
113 | I $D(^UTILITY($J,"W",0)) N I,T S I=0 F S I=$O(^UTILITY($J,"W",0,I)) Q:+I=0 D
|
---|
114 | . S T=$$RT($G(^UTILITY($J,"W",0,I,0))) Q:'$L(T) D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG SUBHDR2 W:I=1 ?3 W:I>1 ?7 W $G(T),!
|
---|
115 | Q
|
---|
116 | CF(GMC,GMT) ; Formats GMC (count) and GMT (text) together
|
---|
117 | S GMC=+($G(GMC)),GMT=$G(GMT) Q:'$L(GMT) S GMT=$$LD(GMT)
|
---|
118 | N GMCOL,DIWL,DIWR,DIWF,X S GMCOL=34,DIWL=0,DIWR=80-(GMCOL) K ^UTILITY($J,"W")
|
---|
119 | S:+($G(GMC))=0 X=" "_GMT S:+($G(GMC))>0 X=$J(GMC,2)_". "_GMT D:$G(X)]"" ^DIWP
|
---|
120 | Q
|
---|
121 | ;
|
---|
122 | SUBHDR ; Subheader for Problem List Component
|
---|
123 | N NUM,TOT,NODE S NODE=$G(^TMP("GMPLHS",$J,STATUS,0)) S NUM=$P(NODE,U),TOT=$P(NODE,U,2)
|
---|
124 | D CKP^GMTSUP Q:$D(GMTSQIT) S:TOT>NUM NUM=NUM_" of "_TOT W ?50,NUM_$S(STATUS="A":" Active",STATUS="I":" Inactive",1:"")_" Problems",!
|
---|
125 | SUBHDR2 ; Will be written on new pages
|
---|
126 | D CKP^GMTSUP Q:$D(GMTSQIT) W:STATUS="ALL" "ST" W ?3,"PROBLEM",?53,"LAST MOD",?65,"PROVIDER",! Q
|
---|
127 | ;
|
---|
128 | RM(X) ; Remove MST
|
---|
129 | S X=$G(X) F Q:X'["MST" S X=$P(X,"MST",1)_$P(X,"MST",2)
|
---|
130 | F Q:X'["//" S X=$P(X,"//",1)_"/"_$P(X,"//",2)
|
---|
131 | F Q:$E(X,$L(X))'="/" S X=$E(X,1,($L(X)-1))
|
---|
132 | F Q:$E(X,1)'="/" S X=$E(X,2,$L(X))
|
---|
133 | Q X
|
---|
134 | RF(X) ; Remove Leading Spaces/Punctuation
|
---|
135 | F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
|
---|
136 | F Q:$E(X,1)'=";" S X=$E(X,2,$L(X))
|
---|
137 | F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
|
---|
138 | S X=$$LD(X) Q X
|
---|
139 | LD(X) ; Uppercase Leading Character
|
---|
140 | Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(X,2,$L(X))
|
---|
141 | RT(X) ; Right Trim Spaces
|
---|
142 | S X=$G(X) F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
|
---|
143 | Q X
|
---|
144 | UP(X) ; Uppercase
|
---|
145 | Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
---|