source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQQPL.m@ 635

Last change on this file since 635 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1ORQQPL ; slc/CLA/REV - Functions which return patient problem list data ;12/15/97 [ 23-APR-1999 11:02:10 ]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,10,85,173**;Dec 17, 1997
3LIST(ORPY,DFN,STATUS) ;return pt's problem list in format: ien^description^
4 ; ICD^onset^last modified^SC^SpExp
5 ; STATUS = status of problems to return: (A)CTIVE, (I)NACTIVE, ("")ALL
6 Q:'DFN
7 N ORGMPL,I,DETAIL,ORICD186
8 S ORICD186=$$PATCH^XPDUTL("ICD*18.0*6")
9 I $L($T(LIST^GMPLUTL2))>0 D
10 .D LIST^GMPLUTL2(.ORGMPL,DFN,STATUS)
11 .Q:'$D(ORGMPL(0))
12 .S DETAIL=$$DETAIL^ORWCV1(10)
13 .F I=1:1:ORGMPL(0) D
14 ..S X=ORGMPL(I),ORPY(I)=$P(X,U)_U_$P(X,U,3)_U_$P(X,U,2)_U_$P(X,U,4)_U_$P(X,U,5)_U_$P(X,U,6)_U_$P(X,U,7)_U_$P(X,U,8)_U_$P(X,U,10)_U_$P(X,U,9)_U_U_DETAIL
15 ..I +ORICD186,'+$$STATCHK^ICDAPIU($P(ORPY(I),U,4),DT) D
16 ...S $P(ORPY(I),U,13)="#",$P(ORPY(I),U,9)="#"
17 .S:+$G(ORPY(1))<1 ORPY(1)="^No problems found."
18 I $L($T(LIST^GMPLUTL2))<1 S ORPY(1)="^Problem list not available.^"
19 K X
20 Q
21DETAIL(Y,DFN,PROBIEN,ID) ; RETURN DETAILED PROBLEM DATA
22 N ORGMPL,GMPDT
23 I $L($T(DETAIL^GMPLUTL2))>0 D
24 .D DETAIL^GMPLUTL2(PROBIEN,.ORGMPL)
25 .N CR,I,J S CR=$CHAR(13),I=1
26 .S Y(I)=ORGMPL("NARRATIVE")_" ("_ORGMPL("DIAGNOSIS")_")",I=I+1
27 .I $$PATCH^XPDUTL("ICD*18.0*6"),'+$$STATCHK^ICDAPIU(ORGMPL("DIAGNOSIS"),DT) D
28 ..S Y(I)="*** The ICD code "_ORGMPL("DIAGNOSIS")_" is currently inactive. ***",I=I+1
29 .S Y(I)=" ",I=I+1
30 .S Y(I)=" Onset: "_ORGMPL("ONSET"),I=I+1
31 .S Y(I)=" Status: "_ORGMPL("STATUS")
32 .S Y(I)=Y(I)_$S(ORGMPL("PRIORITY")="ACUTE":"/ACUTE",ORGMPL("PRIORITY")="CHRONIC":"/CHRONIC",1:""),I=I+1
33 .S Y(I)=" SC Cond: "_ORGMPL("SC"),I=I+1
34 .S Y(I)="Exposure: "_$S($G(ORGMPL("EXPOSURE"))>0:ORGMPL("EXPOSURE",1),1:"None"),I=I+1
35 .I $G(ORGMPL("EXPOSURE"))>1 F J=2:1:ORGMPL("EXPOSURE") D
36 ..S Y(I)=" "_ORGMPL("EXPOSURE",J),I=I+1
37 .S Y(I)=" ",I=I+1
38 .S Y(I)="Provider: "_ORGMPL("PROVIDER"),I=I+1
39 .S Y(I)=" Clinic: "_ORGMPL("CLINIC"),I=I+1
40 .S Y(I)=" ",I=I+1
41 .S Y(I)="Recorded: "_$P(ORGMPL("RECORDED"),U)_", by "_$P(ORGMPL("RECORDED"),U,2),I=I+1
42 .S Y(I)=" Entered: "_$P(ORGMPL("ENTERED"),U)_", by "_$P(ORGMPL("ENTERED"),U,2),I=I+1
43 .S Y(I)=" Updated: "_ORGMPL("MODIFIED"),I=I+1
44 .S Y(I)=" ",I=I+1
45 .;S Y(I)=" Comment: "_$S($G(ORGMPL("COMMENT"))>0:ORGMPL("COMMENT"),1:"")
46 .I $G(ORGMPL("COMMENT"))>0 D
47 ..S Y(I)="----------- Comments -----------",I=I+1
48 ..;F J=ORGMPL("COMMENT"):-1:1 D
49 ..;.S Y(I)=ORGMPL("COMMENT",J)
50 ..;.S Y(I)=$P(Y(I),U)_" by "_$P(Y(I),U,2)_": "_$P(Y(I),U,3),I=I+1
51 ..F J=1:1:ORGMPL("COMMENT") D
52 ...S Y(I)=ORGMPL("COMMENT",J)
53 ...S Y(I)=$P(Y(I),U)_" by "_$P(Y(I),U,2)_": "_$P(Y(I),U,3),I=I+1
54 .S Y(I)=" ",I=I+1
55 .D HIST^ORQQPL2(.GMPDT,PROBIEN)
56 .I $G(GMPDT(0))>0 D
57 ..S Y(I)="----------- Audit History -----------",I=I+1
58 ..F J=1:1:GMPDT(0) S Y(I)=$P(GMPDT(J),U)_": "_$P(GMPDT(J),U,2),I=I+1
59 I $L($T(DETAIL^GMPLUTL2))<1 S Y(1)="Problem list not available."
60 Q
61HASPROB(ORDFN,ORPROB) ;extrinsic function returns 1^problem text;ICD9 if
62 ;pt has an active problem which contains any piece of ORPROB
63 ;ORDFN patient DFN
64 ;ORPROB problems to check vs. active prob list in format: PROB1TEXT;PROB1ICD^PROB2TEXT;PROB2ICD^PROB3...
65 ;if ICD includes "." an exact match will be sought
66 ;if not, a match of general ICD category will be sought
67 ;Note: All ICD codes passed must be preceded with ";"
68 Q:+$G(ORDFN)<1 "0^Patient not identified."
69 Q:'$L($G(ORPROB)) "0^Problem not identified."
70 N ORQAPL,ORQY,ORI,ORJ,ORCNT,ORQPL,ORQICD,ORQRSLT
71 D LIST(.ORQY,ORDFN,"A")
72 Q:$P(ORQY(1),U)="" "0^No active problems found."
73 S ORQRSLT="0^No matching problems found."
74 S ORCNT=$L(ORPROB,U)
75 S ORI=0 F S ORI=$O(ORQY(ORI)) Q:ORI<1 D
76 .S ORQAPL=ORQY(ORI)
77 .F ORJ=1:1:ORCNT D
78 ..S ORQPL=$P($P(ORPROB,U,ORJ),";"),ORQICD=$P($P(ORPROB,U,ORJ),";",2)
79 ..;if problem text and pt's problem contains problem text passed:
80 ..I $L(ORQPL),($P(ORQAPL,U,2)[ORQPL) D
81 ...S ORQRSLT="1^"_$P(ORQAPL,U,2)_";"_$P(ORQAPL,U,4)
82 ..;
83 ..;if specific ICD (contains ".") and pt's ICD equals ICD passed:
84 ..I $L(ORQICD),(ORQICD["."),($P(ORQAPL,U,4)=ORQICD) D
85 ...S ORQRSLT="1^"_$P(ORQAPL,U,2)_";"_$P(ORQAPL,U,4)
86 ..;
87 ..;if non-specific ICD and pt's ICD category equals ICD category passed:
88 ..I $L(ORQICD),(ORQICD'["."),($P($P(ORQAPL,U,4),".")=ORQICD) D
89 ...S ORQRSLT="1^"_$P(ORQAPL,U,2)_";"_$P(ORQAPL,U,4)
90 Q ORQRSLT
Note: See TracBrowser for help on using the repository browser.