source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPNCV2.m@ 691

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

initial load of WorldVistAEHR
File size: 3.5 KB
Line 
1TIUPNCV2 ;SLC/DJP-SF/JLI ;11/24/97 13:17
2 ;;1.0;TEXT INTEGRATION UTILITIES;**9**;Jun 20, 1997
3WHATSIT ;Determines component type
4 S A=GMRPFLD
5 ;
6 ;Admission/Assessment Sections
7 I A>39&(A<46) S LNHDR="ADMISSION ASSESSMENT",TX=$S(A=40:"EMOTIONAL STATE",A=41:"BEHAVIORAL ASSESSMENT",A=42:"SOCIAL STATUS",A=43:"REHABILITATION POTENTIAL",A=44:"EMPLOYMENT POTENTIAL",A=45:"DEGREE OF DANGER",1:"") D:TX'="" COUNTS Q
8 I A>45&(A<49) S LNHDR="ADMISSION ASSESSMENT",TX=$S(A=46:"ABNORMAL PHYSICAL FINDINGS",A=47:"INITIAL IMPRESSION/PROVISIONAL DX",A=48:"STATEMENT OF TREATMENT PLANNED",1:"") D:TX'="" COUNTS Q
9 ;
10 ;Final Discharge Note Segments
11 I A>29&(A<35) S LNHDR="FINAL DISCHARGE NOTE",TX=$S(A=30:"DXLS",A=31:"DISCHARGE BED SECTION",A=32:"OTHER DIAGNOSES",A=33:"OPERATIONS/PROCEDURES",A=34:"INSTRUCTIONS GIVEN TO PATIENT",1:"") D:TX'="" COUNTS Q
12 ;
13 ;SOAP Note Segments
14 I A>19&(A<24) S LNHDR="SOAP - GENERAL NOTE",TX=$S(A=20:"SUBJECTIVE",A=21:"OBJECTIVE",A=22:"ASSESSMENT",A=23:"PLAN",1:"") D:TX'="" COUNTS Q
15 I A=10 S LNHDR="" K TX D COUNTS
16 I A=8 S LNHDR="",TX="COMMENTS" D COUNTS
17 Q
18 ;
19COUNTS ;Pieces out line counts for word-processing fields
20 I $D(TX) S SUBTIL=TX
21 I (A=30)!(A=31)!(A=32) D SPECIAL Q
22 S CNTA=$P(^GMR(121,GMRPIFN,GMRPFLD,0),U,3)
23 S CNTB=$P(^GMR(121,GMRPIFN,GMRPFLD,0),U,4)
24 S TEXTDT=$P(^GMR(121,GMRPIFN,GMRPFLD,0),U,5)
25 D ONEDOC
26 Q
27 ;
28ONEDOC ;Pulls formatted notes together into a single word processing field
29 S RENUM=1
30 S CNT1=(CNT1+CNTA),CNT2=(CNT2+CNTB),FLD=GMRPFLD I GMRPFLD=8 S FLD=99
31 S ^TMP("TIUMERGE",GMRPIFN,0)="^"_"^"_CNT1_"^"_CNT2_"^"_TEXTDT
32 M ^TMP("TIUMERGE",GMRPIFN,FLD)=^GMR(121,GMRPIFN,GMRPFLD)
33 I $D(SUBTIL)&(GMRPFLD'=8)
34 I S ^TMP("TIUMERGE",GMRPIFN,GMRPFLD,"TITLE")=SUBTIL
35 K SUBTIL
36 Q
37 ;
38COMMENT ;Appends word-processing contained in Field 8 - COMMENT
39 S X="COMMENT",GMRPFLD=8,RENUM=1,A=GMRPFLD
40 D COUNTS
41 S ^TMP("TIUMERGE",GMRPIFN,8,"TITLE")="COMMENT"
42 Q
43 ;
44RENUM ;Renumbers WP fields and inserts TITLE of component within field.
45 S PNFLD=0,T1=0,T2=0
46 F PNFLD=0:0 S PNFLD=$O(^TMP("TIUMERGE",GMRPIFN,PNFLD)) Q:PNFLD'>0 D
47 . I $D(^TMP("TIUMERGE",GMRPIFN,PNFLD,0)) K ^TMP("TIUMERGE",GMRPIFN,PNFLD,0)
48 . D SETHOLD
49 S ^TMP("TIUHOLD",GMRPIFN,10,0)="^^"_T2_"^"_T2_"^"_TEXTDT
50 K T1,T2,PNFLD
51 Q
52 ;
53SETHOLD ;Sets ^TMP("TIUHOLD") which contains the resequenced note
54 I $D(^TMP("TIUMERGE",GMRPIFN,PNFLD,"TITLE")) D
55 . S PNHDR=$P(^TMP("TIUMERGE",GMRPIFN,PNFLD,"TITLE"),U,1)
56 . S T2=(T2+1)
57 . S ^TMP("TIUHOLD",GMRPIFN,10,T2,0)=PNHDR
58 . K PNHDR
59 . K ^TMP("TIUMERGE",GMRPIFN,PNFLD,"TITLE")
60 F T1=0:0 S T1=$O(^TMP("TIUMERGE",GMRPIFN,PNFLD,T1)) Q:T1'>0 S T2=(T2+1),^TMP("TIUHOLD",GMRPIFN,10,T2,0)=^TMP("TIUMERGE",GMRPIFN,PNFLD,T1,0)
61 Q
62 ;
63SPECIAL ;Handles fields other than Word Processing
64 ;DXLS
65 I $P($G(^GMR(121,GMRPIFN,30)),U,1) S TIUDX=$P(^(30),U,1),SPECIAL=$$DXLS^TIUPNCV3(TIUDX),GMRPFLD=30,SUBTIL="DXLS" D SETSPEC
66 ;BEDSECTION
67 I $P($G(^GMR(121,GMRPIFN,30)),U,2) S TIUBS=$P(^(30),U,2),SPECIAL=$$BEDSEC^TIUPNCV3(TIUBS),GMRPFLD=31,SUBTIL="DISCHARGE BED SECTION" D SETSPEC
68 ;OTHER DIAGNOSES
69 I $D(^GMR(121,GMRPIFN,32)) S GMRPFLD=32,SUBTIL="OTHER DIAGNOSES" D FREETXT
70 Q
71 ;
72SETSPEC ;Converts non-word-processing fields into word-processing fields
73 S ^TMP("TIUMERGE",GMRPIFN,GMRPFLD,1,0)=SUBTIL_":"
74 S ^TMP("TIUMERGE",GMRPIFN,GMRPFLD,2,0)=SPECIAL
75 K SUBTIL
76 Q
77 ;
78FREETXT ;Converts multiple freetext field into word-processing fields
79 S F2=0,F3=1,^TMP("TIUMERGE",GMRPIFN,GMRPFLD,1,0)=SUBTIL_":"
80 S F1=$P(^GMR(121,GMRPIFN,GMRPFLD,0),U,3) F F2=1:1:F1 D
81 . S F3=F3+1
82 . S ^TMP("TIUMERGE",GMRPIFN,GMRPFLD,F3,0)=$G(^GMR(121,GMRPIFN,GMRPFLD,F2,0))
83 K SUBTIL,F1,F2,F3
84 Q
Note: See TracBrowser for help on using the repository browser.