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
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPNCV2 3671 printed Apr 09, 2024@21:42:57 Page 2
TIUPNCV2 ;SLC/DJP-SF/JLI ;11/24/97 13:17
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**9**;Jun 20, 1997
WHATSIT ;Determines component type
+1 SET A=GMRPFLD
+2 ;
+3 ;Admission/Assessment Sections
+4 IF A>39&(A<46)
SET LNHDR="ADMISSION ASSESSMENT"
SET TX=$SELECT(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:"")
if TX'=""
DO COUNTS
QUIT
+5 IF A>45&(A<49)
SET LNHDR="ADMISSION ASSESSMENT"
SET TX=$SELECT(A=46:"ABNORMAL PHYSICAL FINDINGS",A=47:"INITIAL IMPRESSION/PROVISIONAL DX",A=48:"STATEMENT OF TREATMENT PLANNED",1:"")
if TX'=""
DO COUNTS
QUIT
+6 ;
+7 ;Final Discharge Note Segments
+8 IF A>29&(A<35)
SET LNHDR="FINAL DISCHARGE NOTE"
SET TX=$SELECT(A=30:"DXLS",A=31:"DISCHARGE BED SECTION",A=32:"OTHER DIAGNOSES",A=33:"OPERATIONS/PROCEDURES",A=34:"INSTRUCTIONS GIVEN TO PATIENT",1:"")
if TX'=""
DO COUNTS
QUIT
+9 ;
+10 ;SOAP Note Segments
+11 IF A>19&(A<24)
SET LNHDR="SOAP - GENERAL NOTE"
SET TX=$SELECT(A=20:"SUBJECTIVE",A=21:"OBJECTIVE",A=22:"ASSESSMENT",A=23:"PLAN",1:"")
if TX'=""
DO COUNTS
QUIT
+12 IF A=10
SET LNHDR=""
KILL TX
DO COUNTS
+13 IF A=8
SET LNHDR=""
SET TX="COMMENTS"
DO COUNTS
+14 QUIT
+15 ;
COUNTS ;Pieces out line counts for word-processing fields
+1 IF $DATA(TX)
SET SUBTIL=TX
+2 IF (A=30)!(A=31)!(A=32)
DO SPECIAL
QUIT
+3 SET CNTA=$PIECE(^GMR(121,GMRPIFN,GMRPFLD,0),U,3)
+4 SET CNTB=$PIECE(^GMR(121,GMRPIFN,GMRPFLD,0),U,4)
+5 SET TEXTDT=$PIECE(^GMR(121,GMRPIFN,GMRPFLD,0),U,5)
+6 DO ONEDOC
+7 QUIT
+8 ;
ONEDOC ;Pulls formatted notes together into a single word processing field
+1 SET RENUM=1
+2 SET CNT1=(CNT1+CNTA)
SET CNT2=(CNT2+CNTB)
SET FLD=GMRPFLD
IF GMRPFLD=8
SET FLD=99
+3 SET ^TMP("TIUMERGE",GMRPIFN,0)="^"_"^"_CNT1_"^"_CNT2_"^"_TEXTDT
+4 MERGE ^TMP("TIUMERGE",GMRPIFN,FLD)=^GMR(121,GMRPIFN,GMRPFLD)
+5 IF $DATA(SUBTIL)&(GMRPFLD'=8)
+6 IF $TEST
SET ^TMP("TIUMERGE",GMRPIFN,GMRPFLD,"TITLE")=SUBTIL
+7 KILL SUBTIL
+8 QUIT
+9 ;
+1 SET X="COMMENT"
SET GMRPFLD=8
SET RENUM=1
SET A=GMRPFLD
+2 DO COUNTS
+3 SET ^TMP("TIUMERGE",GMRPIFN,8,"TITLE")="COMMENT"
+4 QUIT
+5 ;
RENUM ;Renumbers WP fields and inserts TITLE of component within field.
+1 SET PNFLD=0
SET T1=0
SET T2=0
+2 FOR PNFLD=0:0
SET PNFLD=$ORDER(^TMP("TIUMERGE",GMRPIFN,PNFLD))
if PNFLD'>0
QUIT
Begin DoDot:1
+3 IF $DATA(^TMP("TIUMERGE",GMRPIFN,PNFLD,0))
KILL ^TMP("TIUMERGE",GMRPIFN,PNFLD,0)
+4 DO SETHOLD
End DoDot:1
+5 SET ^TMP("TIUHOLD",GMRPIFN,10,0)="^^"_T2_"^"_T2_"^"_TEXTDT
+6 KILL T1,T2,PNFLD
+7 QUIT
+8 ;
SETHOLD ;Sets ^TMP("TIUHOLD") which contains the resequenced note
+1 IF $DATA(^TMP("TIUMERGE",GMRPIFN,PNFLD,"TITLE"))
Begin DoDot:1
+2 SET PNHDR=$PIECE(^TMP("TIUMERGE",GMRPIFN,PNFLD,"TITLE"),U,1)
+3 SET T2=(T2+1)
+4 SET ^TMP("TIUHOLD",GMRPIFN,10,T2,0)=PNHDR
+5 KILL PNHDR
+6 KILL ^TMP("TIUMERGE",GMRPIFN,PNFLD,"TITLE")
End DoDot:1
+7 FOR T1=0:0
SET T1=$ORDER(^TMP("TIUMERGE",GMRPIFN,PNFLD,T1))
if T1'>0
QUIT
SET T2=(T2+1)
SET ^TMP("TIUHOLD",GMRPIFN,10,T2,0)=^TMP("TIUMERGE",GMRPIFN,PNFLD,T1,0)
+8 QUIT
+9 ;
SPECIAL ;Handles fields other than Word Processing
+1 ;DXLS
+2 IF $PIECE($GET(^GMR(121,GMRPIFN,30)),U,1)
SET TIUDX=$PIECE(^(30),U,1)
SET SPECIAL=$$DXLS^TIUPNCV3(TIUDX)
SET GMRPFLD=30
SET SUBTIL="DXLS"
DO SETSPEC
+3 ;BEDSECTION
+4 IF $PIECE($GET(^GMR(121,GMRPIFN,30)),U,2)
SET TIUBS=$PIECE(^(30),U,2)
SET SPECIAL=$$BEDSEC^TIUPNCV3(TIUBS)
SET GMRPFLD=31
SET SUBTIL="DISCHARGE BED SECTION"
DO SETSPEC
+5 ;OTHER DIAGNOSES
+6 IF $DATA(^GMR(121,GMRPIFN,32))
SET GMRPFLD=32
SET SUBTIL="OTHER DIAGNOSES"
DO FREETXT
+7 QUIT
+8 ;
SETSPEC ;Converts non-word-processing fields into word-processing fields
+1 SET ^TMP("TIUMERGE",GMRPIFN,GMRPFLD,1,0)=SUBTIL_":"
+2 SET ^TMP("TIUMERGE",GMRPIFN,GMRPFLD,2,0)=SPECIAL
+3 KILL SUBTIL
+4 QUIT
+5 ;
FREETXT ;Converts multiple freetext field into word-processing fields
+1 SET F2=0
SET F3=1
SET ^TMP("TIUMERGE",GMRPIFN,GMRPFLD,1,0)=SUBTIL_":"
+2 SET F1=$PIECE(^GMR(121,GMRPIFN,GMRPFLD,0),U,3)
FOR F2=1:1:F1
Begin DoDot:1
+3 SET F3=F3+1
+4 SET ^TMP("TIUMERGE",GMRPIFN,GMRPFLD,F3,0)=$GET(^GMR(121,GMRPIFN,GMRPFLD,F2,0))
End DoDot:1
+5 KILL SUBTIL,F1,F2,F3
+6 QUIT
