- 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 23, 2025@18:57:48 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
