85 lines
3.5 KiB
Mathematica
85 lines
3.5 KiB
Mathematica
TIUPNCV2 ;SLC/DJP-SF/JLI ;11/24/97 13:17
|
|
;;1.0;TEXT INTEGRATION UTILITIES;**9**;Jun 20, 1997
|
|
WHATSIT ;Determines component type
|
|
S A=GMRPFLD
|
|
;
|
|
;Admission/Assessment Sections
|
|
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
|
|
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
|
|
;
|
|
;Final Discharge Note Segments
|
|
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
|
|
;
|
|
;SOAP Note Segments
|
|
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
|
|
I A=10 S LNHDR="" K TX D COUNTS
|
|
I A=8 S LNHDR="",TX="COMMENTS" D COUNTS
|
|
Q
|
|
;
|
|
COUNTS ;Pieces out line counts for word-processing fields
|
|
I $D(TX) S SUBTIL=TX
|
|
I (A=30)!(A=31)!(A=32) D SPECIAL Q
|
|
S CNTA=$P(^GMR(121,GMRPIFN,GMRPFLD,0),U,3)
|
|
S CNTB=$P(^GMR(121,GMRPIFN,GMRPFLD,0),U,4)
|
|
S TEXTDT=$P(^GMR(121,GMRPIFN,GMRPFLD,0),U,5)
|
|
D ONEDOC
|
|
Q
|
|
;
|
|
ONEDOC ;Pulls formatted notes together into a single word processing field
|
|
S RENUM=1
|
|
S CNT1=(CNT1+CNTA),CNT2=(CNT2+CNTB),FLD=GMRPFLD I GMRPFLD=8 S FLD=99
|
|
S ^TMP("TIUMERGE",GMRPIFN,0)="^"_"^"_CNT1_"^"_CNT2_"^"_TEXTDT
|
|
M ^TMP("TIUMERGE",GMRPIFN,FLD)=^GMR(121,GMRPIFN,GMRPFLD)
|
|
I $D(SUBTIL)&(GMRPFLD'=8)
|
|
I S ^TMP("TIUMERGE",GMRPIFN,GMRPFLD,"TITLE")=SUBTIL
|
|
K SUBTIL
|
|
Q
|
|
;
|
|
COMMENT ;Appends word-processing contained in Field 8 - COMMENT
|
|
S X="COMMENT",GMRPFLD=8,RENUM=1,A=GMRPFLD
|
|
D COUNTS
|
|
S ^TMP("TIUMERGE",GMRPIFN,8,"TITLE")="COMMENT"
|
|
Q
|
|
;
|
|
RENUM ;Renumbers WP fields and inserts TITLE of component within field.
|
|
S PNFLD=0,T1=0,T2=0
|
|
F PNFLD=0:0 S PNFLD=$O(^TMP("TIUMERGE",GMRPIFN,PNFLD)) Q:PNFLD'>0 D
|
|
. I $D(^TMP("TIUMERGE",GMRPIFN,PNFLD,0)) K ^TMP("TIUMERGE",GMRPIFN,PNFLD,0)
|
|
. D SETHOLD
|
|
S ^TMP("TIUHOLD",GMRPIFN,10,0)="^^"_T2_"^"_T2_"^"_TEXTDT
|
|
K T1,T2,PNFLD
|
|
Q
|
|
;
|
|
SETHOLD ;Sets ^TMP("TIUHOLD") which contains the resequenced note
|
|
I $D(^TMP("TIUMERGE",GMRPIFN,PNFLD,"TITLE")) D
|
|
. S PNHDR=$P(^TMP("TIUMERGE",GMRPIFN,PNFLD,"TITLE"),U,1)
|
|
. S T2=(T2+1)
|
|
. S ^TMP("TIUHOLD",GMRPIFN,10,T2,0)=PNHDR
|
|
. K PNHDR
|
|
. K ^TMP("TIUMERGE",GMRPIFN,PNFLD,"TITLE")
|
|
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)
|
|
Q
|
|
;
|
|
SPECIAL ;Handles fields other than Word Processing
|
|
;DXLS
|
|
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
|
|
;BEDSECTION
|
|
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
|
|
;OTHER DIAGNOSES
|
|
I $D(^GMR(121,GMRPIFN,32)) S GMRPFLD=32,SUBTIL="OTHER DIAGNOSES" D FREETXT
|
|
Q
|
|
;
|
|
SETSPEC ;Converts non-word-processing fields into word-processing fields
|
|
S ^TMP("TIUMERGE",GMRPIFN,GMRPFLD,1,0)=SUBTIL_":"
|
|
S ^TMP("TIUMERGE",GMRPIFN,GMRPFLD,2,0)=SPECIAL
|
|
K SUBTIL
|
|
Q
|
|
;
|
|
FREETXT ;Converts multiple freetext field into word-processing fields
|
|
S F2=0,F3=1,^TMP("TIUMERGE",GMRPIFN,GMRPFLD,1,0)=SUBTIL_":"
|
|
S F1=$P(^GMR(121,GMRPIFN,GMRPFLD,0),U,3) F F2=1:1:F1 D
|
|
. S F3=F3+1
|
|
. S ^TMP("TIUMERGE",GMRPIFN,GMRPFLD,F3,0)=$G(^GMR(121,GMRPIFN,GMRPFLD,F2,0))
|
|
K SUBTIL,F1,F2,F3
|
|
Q
|