source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPNCV2.m@ 1397

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