source: qrda/C0Q/trunk/p/C0QNOTES.m@ 1482

Last change on this file since 1482 was 1438, checked in by Sam Habiel, 13 years ago

Updated routines after many small fixes; added C0QKIDS as well

File size: 4.7 KB
Line 
1C0QNOTES ;GPL - Utility to look up patient notes ; 5/23/12 5:44pm
2 ;;1.0;C0Q;;May 21, 2012;Build 43
3 ;
4 ;2011 George Lilly <glilly@glilly.net> - Licensed under the terms of the GNU
5 ;General Public License See attached copy of the License.
6 ;
7 ;This program is free software; you can redistribute it and/or modify
8 ;it under the terms of the GNU General Public License as published by
9 ;the Free Software Foundation; either version 2 of the License, or
10 ;(at your option) any later version.
11 ;
12 ;This program is distributed in the hope that it will be useful,
13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;GNU General Public License for more details.
16 ;
17 ;You should have received a copy of the GNU General Public License along
18 ;with this program; if not, write to the Free Software Foundation, Inc.,
19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20 ;
21 Q
22HASNTYN(ZNTYP,DFN) ; EXTRINSIC 1 YES 0 NO DOES THE PATIENT DFN HAVE
23 ; NOTE TYPE ZNTYP
24 N C0QN,C0QO
25 S C0QO=$NA(^TIU(8925.1,"B",ZNTYP)) ; ALL DOCUMENT DEFS FOR THIS NAME
26 S C0QN=$NA(^TIU(8925,"AA",DFN)) ; NOTES THE PATIENT HAS
27 N C0QR
28 D UNITY^C0QSET("C0QR",C0QN,C0QO) ; DOES PATIENT HAVE THE NOTE?
29 N ZR
30 I $D(C0QR(1)) S ZR=1
31 E S ZR=0
32 Q ZR
33 ;
34TESTNT(DFN) ; TEST THE NTTXT ROUTINE
35 W !,"MEDICATION RECON IN ER NURSE NOTE"
36 I $$NTTXT("ER NURSE NOTE","MEDICATION RECONCILIATION COMPLET",DFN) W " FOUND"
37 E W " NOT FOUND"
38 W !,"Medication Recon in MED/SURG NURSING ADMISSION ASSESSMENT"
39 I $$NTTXT("MED/SURG NURSING ADMISSION ASSESSMENT","Medication Reconcilation complete",DFN) W "FOUND"
40 E W " NOT FOUND"
41 Q
42 ;
43NTTXT(NTTITLE,NTTXT,DFN) ; EXTRINSIC 1 YES 0 NO DOES PATIENT HAVE
44 ; TEXT NTTXT IN NOTE TITLE NTTITLE
45 N C0QNTA,C0QTYP
46 S C0QDFMT=$O(^TIU(8925.1,"B",NTTITLE,"")) ; DOCUMENT FORMAT IEN
47 S C0QNTA=$NA(^TIU(8925,"AA",DFN,C0QDFMT)) ; ARRAY OF NOTES OF THIS TYPE FOR
48 ;^TIU(8925,"AA",15393,1808,6889171,375262)=""
49 N ZI,ZN,ZD,ZL
50 S ZD="" ; DATE OF THE THE NOTE
51 N FOUND S FOUND=0
52 F S ZD=$O(@C0QNTA@(ZD)) Q:FOUND Q:ZD="" D ; FOR EACH DATE
53 . S ZN=""
54 . F S ZN=$O(@C0QNTA@(ZD,ZN)) Q:FOUND Q:ZN="" D ; EACH NOTE
55 . . W !,"NOTE ",ZN," ",$G(^TIU(8925,ZN,"TEXT",1,0))
56 . . S ZI=0 ; WANT TO STAR ON LINE 1
57 . . S ZL=$NA(^TIU(8925,ZN,"TEXT"))
58 . . F S ZI=$O(@ZL@(ZI)) Q:+ZI=0 D ;
59 . . . I $P($G(@ZL@(ZI,0)),NTTXT,2)'="" S FOUND=1 D ;
60 . . . . W "**********",$G(@ZL@(ZI,0)),!
61 Q FOUND ; IT'S THAT SIMPLE... PLEASE LEAVE SOME TEXT AT THE END OF WHAT
62 ; YOU SEARCH FOR...gpl ... for example is this is the note title:
63 ; MED/SURG NURSING ADMISSION ASSESSMENT
64 ;and this is the text you want: Medication Reconcilation completed.
65 ; search for: Medication Reconcilation complete
66 ; that will leave the "d." in piece two of the line
67 ;
68 ; or for this note:
69 ;ER NURSE NOTE
70 ; and this text:
71 ;MEDICATION RECONCILIATION COMPLETED
72 ; search for MEDICATION RECONCILIATION COMPLET
73 ; which will leave the "ED" in piece 2
74TXTALL(ZRTN,ZTARY,DFN) ; EXTRINSIC WHICH SEARCHES ALL OF A PATIENT'S NOTES
75 ; FOR AN ARRAY OF TEXT MATCHES. ZRTN IS PASSED BY REFERENCE AND IS LIKE
76 ; AN RPC RETURN. ZTARY IS PASSED BY REFERENCE AND HAS THE FORMAT
77 ; ZTARY(1,"TEXT1")="" ZTARY(2,"TEXT2")="" ETC
78 N C0QTYP,C0QDFMT
79 ;S C0QDFMT=$O(^TIU(8925.1,"B",NTTITLE,"")) ; DOCUMENT FORMAT IEN
80 S C0QNTA=$NA(^TIU(8925,"AA",DFN)) ; ARRAY OF NOTES FOR
81 ;^TIU(8925,"AA",15393,1808,6889171,375262)=""
82 N ZI,ZJ,ZN,ZD,ZL,ZT,NTTXT,ZC,ZTYP
83 S ZT=""
84 F S ZT=$O(@C0QNTA@(ZT)) Q:ZT="" D ;
85 . S ZTYP=$$GET1^DIQ(8925.1,ZT_",",.01) ; NAME OF NOTE TITLE
86 . S ZD="" ; DATE OF THE THE NOTE
87 . N FOUND S FOUND=0
88 . F S ZD=$O(@C0QNTA@(ZT,ZD)) Q:FOUND Q:ZD="" D ; FOR EACH DATE
89 . . S ZN=""
90 . . F S ZN=$O(@C0QNTA@(ZT,ZD,ZN)) Q:FOUND Q:ZN="" D ; EACH NOTE
91 . . . W !,"NOTE ",ZN," ",$G(^TIU(8925,ZN,"TEXT",1,0))
92 . . . S ZI=0 ; WANT TO STAR ON LINE 1
93 . . . S ZL=$NA(^TIU(8925,ZN,"TEXT"))
94 . . . F S ZI=$O(@ZL@(ZI)) Q:+ZI=0 D ;
95 . . . . S ZJ="" ; INDEX FOR SEARCH TERMS
96 . . . . F S ZJ=$O(ZTARY(ZJ)) Q:ZJ="" D ; FOR EACH SEARCH TERM
97 . . . . . S ATTR=$O(ZTARY(ZJ,""))
98 . . . . . S NTTXT=$O(ZTARY(ZJ,ATTR,""))
99 . . . . . I $P($G(@ZL@(ZI,0)),NTTXT,2)'="" S FOUND=1 D ;
100 . . . . . . W "**********",$G(@ZL@(ZI,0)),!
101 . . . . . . S ZC=$O(ZRTN(""),-1) ; NEXT COUNT
102 . . . . . . I ZC="" S ZC=1
103 . . . . . . E S ZC=ZC+1
104 . . . . . . S ZRTN(ZC,ATTR,ZTYP,ZN,NTTXT)=$G(@ZL@(ZI,0))
105 Q $G(FOUND) ; IT'S THAT SIMPLE... PLEASE LEAVE SOME TEXT AT THE END OF WHAT
106 ;
107TESTALL ;
108 S GT(1,"HasSmokingStatus","SMOK")=""
109 S GT(2,"HasSmokingStatus","Smok")=""
110 S GT(3,"HasSmokingStatus","smok")=""
111 S GT(4,"HasMedRecon","MEDICATION RECONCILIATION COMPLET")=""
112 S GT(5,"HasMedRecon","Medication Reconcilation Complete")=""
113 W $$TXTALL(.G,.GT,2) ; CHECK ALL PATIENT 2'S NOTEST FOR SMOKING
114 ZWRITE G
115 Q
116 ;
Note: See TracBrowser for help on using the repository browser.