TIUCCRHL7P4 ; CCRA/PB - TIU CCRA HL7 Msg Processing; January 6, 2006
;;1.0;TEXT INTEGRATION UTILITIES;**344,356**;Sep 27, 2023;Build 26
;
;PB - Patch 344 to modify how the note and addendum text is formatted
;PB - Patch 356 modifications to file the note as a stand-alone note and not linked to a consult
Q
WORD ;
K I1,CNT,LCNT,LEN,I,LINES,T2,LASTWORDS,TEST1,WORDS,WORDSLEN,XX
S WORDS=$G(TIUZ("TEXT",1,0)),WORDSLEN=$L(TIUZ("TEXT",1,0))
I $G(ADDENDUM)'="" D
.S:$G(NOTEDATE)="" NOTEDATE=$$GETDATE
.S:$G(NOTENUM)="" NOTENUM=$$NOTENUM
.S TIUIEN=$$TIULKUP^TIUCCHL7UT(CONSULTID,TIU("TDA"),$G(NOTEDATE),$G(NOTENUM)) ;Patch 344 lookup the note in the consult to file the addendum with, Patch 356, changed VNUM to CONSULTID
.;S:$G(NOTENUM)'="" TIUIEN=$$TIULKUP^TIUCCHL7UT(VNUM,TIU("TITLE"),NOTEDATE,NOTENUM) ;Patch 344 lookup the note in the consult to file the addendum with
.;S T2("VETERAN'S"_$C(160)_"CAREGIVER"_$C(160)_"CONTACT")="VETERAN'S CAREGIVER CONTACT",WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
F TEST1=1:1:WORDSLEN S LASTWORDS=$E(TIUZ("TEXT",1,0),WORDSLEN,(WORDSLEN-25))
;K T2 S T2("PROVIDER"_$C(160)_"CONTACT ADDENDUM")="PROVIDER CONTACT ADDENDUM"
;S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
I $G(ADDENDUM)["ADDENDUM" D
.I ADDENDUM["APPOINTMENT MANAGEMENT ADDENDUM" D AMA^TIUCCRHL7P5,FORMAT ;done
.I ADDENDUM["CARE COORDINATION FOLLOW UP ADDENDUM" D CCFUA^TIUCCRHL7P6,FORMAT ;done
.I ADDENDUM["CASE MANAGEMENT ADDENDUM" D CMA^TIUCCRHL7P6,FORMAT ;done
.I ADDENDUM["CONTINUED STAY REVIEW ADDENDUM" D CSRA,FORMAT ;done
.I ADDENDUM["DISCHARGE PLANNING ADDENDUM" D DPA^TIUCCRHL7P5,FORMAT ;done
.I ADDENDUM["DISCHARGE DISPOSITION ADDENDUM" D DISP^TIUCCRHL7P5,FORMAT ;done
.I ADDENDUM["DISEASE MANAGEMENT ADDENDUM" D DMA^TIUCCRHL7P5,FORMAT ;done
.I ADDENDUM["PROVIDER CONTACT ADDENDUM" D PCA^TIUCCRHL7P7,FORMAT ;done
.I ADDENDUM["TRANSFER ADDENDUM" D TA^TIUCCRHL7P7,FORMAT ;done
.I ADDENDUM["VETERAN CONTACT ADDENDUM" D VCA^TIUCCRHL7P7,FORMAT ;done
.I ADDENDUM["VETERAN HANDOFF ADDENDUM" D VHA^TIUCCRHL7P7,FORMAT
;need to take a look at the code int he CCPN code and update it with the code from WORD^TIUCCRHL7P1
;I $G(ADDENDUM)="" D CCPN^TIUCCRHL7P6,FORMAT
Q
FORMAT ;
S LEN=$L(WORDS),I1=1,XX=1,CNT=0,LCNT=0
F I=1:1:LEN D
.S LCNT=LCNT+1
.;I LCNT>100&($E(WORDS,I)=" ")!($E(WORDS,I)=$C(160))!($E(WORDS,I)=$C(10))!($E(WORDS,I)=" "&($E(WORDS,I+1)=" ")&($E(WORDS,I+2)'=" ")) D
.I LCNT>100&($E(WORDS,I)=" ")!($E(WORDS,I)=$C(160))!($E(WORDS,I)=$C(10)) D
..S:XX=1 LINES("TEXT",XX,0)=$$TRIM^XLFSTR($E(WORDS,1,63),"LR"),XX=XX+1,I=64,LCNT=0,I1=I
..Q:XX=1
..S LINES("TEXT",XX,0)=$TR($E(WORDS,I1,I-1),$C(160)," "),LINES("TEXT",XX,0)=$$TRIM^XLFSTR(LINES("TEXT",XX,0),"LR"),XX=XX+1,LCNT=0 ;,I1=I
..W !,$G(LINES("TEXT",XX-1,0))," ",XX-1_"^"_I1_"^"_I_"^"_LCNT
..S I1=I
I I1'=LEN N LASTLINES S LASTLINES=$E(WORDS,I1,I) K T2 S T2($C(160)_" ")="" S LINES("TEXT",XX,0)=$$REPLACE^XLFSTR(LASTLINES,.T2)
M TIUZ("TEXT")=LINES("TEXT")
K LINES("TEXT")
Q
GETDATE() ; parse date/time of original note. Patch 344 mods to parse out the date of the original note
N D1,D2
S D2=""
S D1=$P(WORDS,"Original CCP Note Date (mm/dd/yyyy):",2),D2=$P(D1,"CCPN Number:",1)
K T2 S T2($C(160))="" S D2=$$REPLACE^XLFSTR(D2,.T2),D2=$TR(D2," ","")
S D2=$P(D2,"/",3)_$P(D2,"/",1)_$P(D2,"/",2),D2=$$HL7TFM^XLFDT(D2)
Q $G(D2)
NOTENUM() ;
N N1,N2
S N2=""
;CCPN Number:?2 ? CONSULT AND REFERRAL INFORMATION
S N1=$P(WORDS,"CCPN Number:",2),N2=$P(N1,"CONSULT AND REFERRAL INFORMATION",1)
S N2=$TR(N2,$C(10),""),N2=$TR(N2," ",""),N2=$TR(N2,$C(160),"")
S:N2'?.N N2=+$P(N2,":",2)
Q $G(N2)
CSRA ;
D COMMON
;K T2,T4 S T4=" "_$C(160)_" VETERAN'S"_$C(160)_"CAREGIVER"_$C(160)_"CONTACT INFO",T2(T4)=$C(160)_$C(160)_"VETERAN'S CAREGIVER CONTACT INFOMATION"_$C(160)
K T2,T4 S T4=$C(60)_"************ CONTINUED STAY REVIEW ADDENDUM"_$C(160)_"************ ",T2(T4)=$C(10)_"************ CONTINUED STAY REVIEW ADDENDUM ************" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
;K T2,T4 S T4=" "_$C(160)_" VETERAN'S"_$C(160)_"CAREGIVER"_$C(160)_"CONTACT INFO",T2(T4)=$C(160)_$C(160)_"VETERAN'S CAREGIVER CONTACT INFOMATION"_$C(160)
K T2,T4 S T4="Initial Contact",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Date:",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Date of Admission:",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Date of Procedure:",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Not applicable (Y/N) ",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Facility Name:",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Point of Contact",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Name:",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Point of Contact Dept:",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Point of Contact Phone:",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Point of Contact Fax Number:",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Method of Contact:",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Impatient level of care required:",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Behavioral Health ICU ICU Stepdown Medicine Observation Surgical Telemetry Follow Up ",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Enter/Edit (Include Veteran's status, procedures, admitting diagnosis, etc.)",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="(Include Veteran's status, procedures, admitting diagnosis, etc.):",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Enter/Edit Provider contact information",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Provider contacted information (Enter provider contact information):",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Enter/Edit Level of Care Required",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Impatient level of care required:",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Behavior Health ICU ICU Stepdown Medicine Observation Surgical Telemetry ",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Enter/Edit Anticipated LOS ",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Anticipated Length of Stay: (Days/Weeks/Months)",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Enter/Edit LST Information No Yes",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="(Comment):",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Enter/Edit Isolation",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Contact Precaution (Comment):",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Droplet Precautions (Comment):",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Airborne Precautions (Comment):",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Neutropenic Precautions (Comment):",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Radiation Precautions (Comment):",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Standard Precautions (Comment):",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Contact Enteric Precautions (Comment):",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="AFB Precautions (Comment):",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Unknown Enter/Edit Plan",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Plan:",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="CC Plan may include specialty and associated appt information, date of surgery post op needs, post d/c appointment and any other care coordination plan Plan: ",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Enter/Edit Handoff Information ",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="The Veteran's assigned lead coordinator is",T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T4,T2,T5
Q
COMMON ;
K T2 S T2("Veteran Last Name: ")=$C(160)_"Veteran Last Name: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Veteran First Name: ")=$C(160)_"Veteran First Name: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Veteran Social:")=$C(10)_"Veteran Social:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Date: ")=$C(10)_"Date: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2($C(160)_" Original CCP Note Date (mm/dd/yyyy): ")=$C(160)_"Original CCP Note Date (mm/dd/yyyy): " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("CCPN Number:"_$C(160))=$C(160)_"CCPN Number: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("CONSULT AND REFERRAL INFORMATION")=$C(160)_$C(160)_"CONSULT AND REFERRAL INFORMATION"_$C(160) S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Name of Referring VA Provider: ")=$C(160)_"Name of Referring VA Provider: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Selected SEOC: ")=$C(160)_"Selected SEOC: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Referral Number: ")=$C(160)_"Referral Number: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Unique Consult ID: ")=$C(160)_"Unique Consult ID: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Patient Admitted (Yes/No): If yes, then please complete the Discharge Planning Addendum.",T2($G(T4))=$C(160)_$C(160)_$G(T4) S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4=$C(160)_" Please review all notes, this note may have one or more of the following addenda associated: ",T2($G(T4))=$C(10)_$G(T4) S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Care Coordination Follow Up:"_$C(160))=$C(10)_"Care Coordination Follow Up: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Appointment Management: ")=$C(10)_"Appointment Management: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Case Management: ")=$C(160)_"Case Management: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Continued Stay Review: ")=$C(160)_"Continued Stay Review: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Disease Management: ")=$C(160)_"Disease Management: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Discharge Planning: ")=$C(160)_"Discharge Planning: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Discharge Disposition: ")=$C(160)_"Discharge Disposition: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Veteran Contact: ")=$C(160)_"Veteran Contact: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Provider Contact: ")=$C(160)_"Provider Contact: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Transfer: ")=$C(160)_"Transfer: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Veteran Handoff:"_$C(160))=$C(160)_"Veteran Handoff: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("FACILITY COMMUNITY CARE OFFICE CONTACT")=$C(160)_$C(160)_"FACILITY COMMUNITY CARE OFFICE CONTACT"_$C(160) S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Care Coordination Point of Contact:"_$C(160))=$C(160)_"Care Coordination Point of Contact: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Phone Number: "_$C(160))=$C(160)_"Phone Number: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
;K T2,T4 S T4=" "_$C(160)_" VETERAN'S"_$C(160)_"CAREGIVER"_$C(160)_"CONTACT INFO",T2(T4)=$C(160)_$C(160)_"X VETERAN'S CAREGIVER CONTACT INFOMATION"_$C(160)
K T2,T4 S T4="VETERAN'S CAREGIVER CONTACT INFO",T2(T4)=$C(10)_T4_$C(10) S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="Is Veteran's caregiver same as next of kin listed in the demographic section of CPRS (Yes/No)?: If no, provide the following: ",T2($G(T4))=$C(160)_$G(T4) S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Veteran's Caregiver Point of Contact: ")=$C(160)_"Veteran's Caregiver Point of Contact: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Caregiver's Relationship to Veteran: ")=$C(10)_"Caregiver's Relationship to Veteran: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("Caregiver's Primary Phone Number: ")=$C(10)_"Caregiver's Primary Phone Number: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("PLAN:")=$C(10)_$C(10)_"PLAN: "_$C(10) S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2,T4 S T4="*** CC Plan may include specialty and associated appointment information, date of surgery, post-op needs, post d/c appointment, and any other care coordination plan ***" D
. S T2=$G(T4)=$C(160)_$G(T4)_$C(160) S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T2 S T2("ADDITIONAL NOTES:")=$C(160)_$C(160)_"ADDITIONAL NOTES: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
K T4,T2,T5
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCCRHL7P4 12756 printed Apr 09, 2024@21:44:56 Page 2
TIUCCRHL7P4 ; CCRA/PB - TIU CCRA HL7 Msg Processing; January 6, 2006
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**344,356**;Sep 27, 2023;Build 26
+2 ;
+3 ;PB - Patch 344 to modify how the note and addendum text is formatted
+4 ;PB - Patch 356 modifications to file the note as a stand-alone note and not linked to a consult
+5 QUIT
WORD ;
+1 KILL I1,CNT,LCNT,LEN,I,LINES,T2,LASTWORDS,TEST1,WORDS,WORDSLEN,XX
+2 SET WORDS=$GET(TIUZ("TEXT",1,0))
SET WORDSLEN=$LENGTH(TIUZ("TEXT",1,0))
+3 IF $GET(ADDENDUM)'=""
Begin DoDot:1
+4 if $GET(NOTEDATE)=""
SET NOTEDATE=$$GETDATE
+5 if $GET(NOTENUM)=""
SET NOTENUM=$$NOTENUM
+6 ;Patch 344 lookup the note in the consult to file the addendum with, Patch 356, changed VNUM to CONSULTID
SET TIUIEN=$$TIULKUP^TIUCCHL7UT(CONSULTID,TIU("TDA"),$GET(NOTEDATE),$GET(NOTENUM))
+7 ;S:$G(NOTENUM)'="" TIUIEN=$$TIULKUP^TIUCCHL7UT(VNUM,TIU("TITLE"),NOTEDATE,NOTENUM) ;Patch 344 lookup the note in the consult to file the addendum with
+8 ;S T2("VETERAN'S"_$C(160)_"CAREGIVER"_$C(160)_"CONTACT")="VETERAN'S CAREGIVER CONTACT",WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
End DoDot:1
+9 FOR TEST1=1:1:WORDSLEN
SET LASTWORDS=$EXTRACT(TIUZ("TEXT",1,0),WORDSLEN,(WORDSLEN-25))
+10 ;K T2 S T2("PROVIDER"_$C(160)_"CONTACT ADDENDUM")="PROVIDER CONTACT ADDENDUM"
+11 ;S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+12 IF $GET(ADDENDUM)["ADDENDUM"
Begin DoDot:1
+13 ;done
IF ADDENDUM["APPOINTMENT MANAGEMENT ADDENDUM"
DO AMA^TIUCCRHL7P5
DO FORMAT
+14 ;done
IF ADDENDUM["CARE COORDINATION FOLLOW UP ADDENDUM"
DO CCFUA^TIUCCRHL7P6
DO FORMAT
+15 ;done
IF ADDENDUM["CASE MANAGEMENT ADDENDUM"
DO CMA^TIUCCRHL7P6
DO FORMAT
+16 ;done
IF ADDENDUM["CONTINUED STAY REVIEW ADDENDUM"
DO CSRA
DO FORMAT
+17 ;done
IF ADDENDUM["DISCHARGE PLANNING ADDENDUM"
DO DPA^TIUCCRHL7P5
DO FORMAT
+18 ;done
IF ADDENDUM["DISCHARGE DISPOSITION ADDENDUM"
DO DISP^TIUCCRHL7P5
DO FORMAT
+19 ;done
IF ADDENDUM["DISEASE MANAGEMENT ADDENDUM"
DO DMA^TIUCCRHL7P5
DO FORMAT
+20 ;done
IF ADDENDUM["PROVIDER CONTACT ADDENDUM"
DO PCA^TIUCCRHL7P7
DO FORMAT
+21 ;done
IF ADDENDUM["TRANSFER ADDENDUM"
DO TA^TIUCCRHL7P7
DO FORMAT
+22 ;done
IF ADDENDUM["VETERAN CONTACT ADDENDUM"
DO VCA^TIUCCRHL7P7
DO FORMAT
+23 IF ADDENDUM["VETERAN HANDOFF ADDENDUM"
DO VHA^TIUCCRHL7P7
DO FORMAT
End DoDot:1
+24 ;need to take a look at the code int he CCPN code and update it with the code from WORD^TIUCCRHL7P1
+25 ;I $G(ADDENDUM)="" D CCPN^TIUCCRHL7P6,FORMAT
+26 QUIT
FORMAT ;
+1 SET LEN=$LENGTH(WORDS)
SET I1=1
SET XX=1
SET CNT=0
SET LCNT=0
+2 FOR I=1:1:LEN
Begin DoDot:1
+3 SET LCNT=LCNT+1
+4 ;I LCNT>100&($E(WORDS,I)=" ")!($E(WORDS,I)=$C(160))!($E(WORDS,I)=$C(10))!($E(WORDS,I)=" "&($E(WORDS,I+1)=" ")&($E(WORDS,I+2)'=" ")) D
+5 IF LCNT>100&($EXTRACT(WORDS,I)=" ")!($EXTRACT(WORDS,I)=$CHAR(160))!($EXTRACT(WORDS,I)=$CHAR(10))
Begin DoDot:2
+6 if XX=1
SET LINES("TEXT",XX,0)=$$TRIM^XLFSTR($EXTRACT(WORDS,1,63),"LR")
SET XX=XX+1
SET I=64
SET LCNT=0
SET I1=I
+7 if XX=1
QUIT
+8 ;,I1=I
SET LINES("TEXT",XX,0)=$TRANSLATE($EXTRACT(WORDS,I1,I-1),$CHAR(160)," ")
SET LINES("TEXT",XX,0)=$$TRIM^XLFSTR(LINES("TEXT",XX,0),"LR")
SET XX=XX+1
SET LCNT=0
+9 WRITE !,$GET(LINES("TEXT",XX-1,0))," ",XX-1_"^"_I1_"^"_I_"^"_LCNT
+10 SET I1=I
End DoDot:2
End DoDot:1
+11 IF I1'=LEN
NEW LASTLINES
SET LASTLINES=$EXTRACT(WORDS,I1,I)
KILL T2
SET T2($CHAR(160)_" ")=""
SET LINES("TEXT",XX,0)=$$REPLACE^XLFSTR(LASTLINES,.T2)
+12 MERGE TIUZ("TEXT")=LINES("TEXT")
+13 KILL LINES("TEXT")
+14 QUIT
GETDATE() ; parse date/time of original note. Patch 344 mods to parse out the date of the original note
+1 NEW D1,D2
+2 SET D2=""
+3 SET D1=$PIECE(WORDS,"Original CCP Note Date (mm/dd/yyyy):",2)
SET D2=$PIECE(D1,"CCPN Number:",1)
+4 KILL T2
SET T2($CHAR(160))=""
SET D2=$$REPLACE^XLFSTR(D2,.T2)
SET D2=$TRANSLATE(D2," ","")
+5 SET D2=$PIECE(D2,"/",3)_$PIECE(D2,"/",1)_$PIECE(D2,"/",2)
SET D2=$$HL7TFM^XLFDT(D2)
+6 QUIT $GET(D2)
NOTENUM() ;
+1 NEW N1,N2
+2 SET N2=""
+3 ;CCPN Number:?2 ? CONSULT AND REFERRAL INFORMATION
+4 SET N1=$PIECE(WORDS,"CCPN Number:",2)
SET N2=$PIECE(N1,"CONSULT AND REFERRAL INFORMATION",1)
+5 SET N2=$TRANSLATE(N2,$CHAR(10),"")
SET N2=$TRANSLATE(N2," ","")
SET N2=$TRANSLATE(N2,$CHAR(160),"")
+6 if N2'?.N
SET N2=+$PIECE(N2,":",2)
+7 QUIT $GET(N2)
CSRA ;
+1 DO COMMON
+2 ;K T2,T4 S T4=" "_$C(160)_" VETERAN'S"_$C(160)_"CAREGIVER"_$C(160)_"CONTACT INFO",T2(T4)=$C(160)_$C(160)_"VETERAN'S CAREGIVER CONTACT INFOMATION"_$C(160)
+3 KILL T2,T4
SET T4=$CHAR(60)_"************ CONTINUED STAY REVIEW ADDENDUM"_$CHAR(160)_"************ "
SET T2(T4)=$CHAR(10)_"************ CONTINUED STAY REVIEW ADDENDUM ************"
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+4 ;K T2,T4 S T4=" "_$C(160)_" VETERAN'S"_$C(160)_"CAREGIVER"_$C(160)_"CONTACT INFO",T2(T4)=$C(160)_$C(160)_"VETERAN'S CAREGIVER CONTACT INFOMATION"_$C(160)
+5 KILL T2,T4
SET T4="Initial Contact"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+6 KILL T2,T4
SET T4="Date:"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+7 KILL T2,T4
SET T4="Date of Admission:"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+8 KILL T2,T4
SET T4="Date of Procedure:"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+9 KILL T2,T4
SET T4="Not applicable (Y/N) "
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+10 KILL T2,T4
SET T4="Facility Name:"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+11 KILL T2,T4
SET T4="Point of Contact"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+12 KILL T2,T4
SET T4="Name:"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+13 KILL T2,T4
SET T4="Point of Contact Dept:"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+14 KILL T2,T4
SET T4="Point of Contact Phone:"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+15 KILL T2,T4
SET T4="Point of Contact Fax Number:"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+16 KILL T2,T4
SET T4="Method of Contact:"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+17 KILL T2,T4
SET T4="Impatient level of care required:"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+18 KILL T2,T4
SET T4="Behavioral Health ICU ICU Stepdown Medicine Observation Surgical Telemetry Follow Up "
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+19 KILL T2,T4
SET T4="Enter/Edit (Include Veteran's status, procedures, admitting diagnosis, etc.)"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+20 KILL T2,T4
SET T4="(Include Veteran's status, procedures, admitting diagnosis, etc.):"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+21 KILL T2,T4
SET T4="Enter/Edit Provider contact information"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+22 KILL T2,T4
SET T4="Provider contacted information (Enter provider contact information):"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+23 KILL T2,T4
SET T4="Enter/Edit Level of Care Required"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+24 KILL T2,T4
SET T4="Impatient level of care required:"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+25 KILL T2,T4
SET T4="Behavior Health ICU ICU Stepdown Medicine Observation Surgical Telemetry "
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+26 KILL T2,T4
SET T4="Enter/Edit Anticipated LOS "
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+27 KILL T2,T4
SET T4="Anticipated Length of Stay: (Days/Weeks/Months)"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+28 KILL T2,T4
SET T4="Enter/Edit LST Information No Yes"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+29 KILL T2,T4
SET T4="(Comment):"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+30 KILL T2,T4
SET T4="Enter/Edit Isolation"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+31 KILL T2,T4
SET T4="Contact Precaution (Comment):"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+32 KILL T2,T4
SET T4="Droplet Precautions (Comment):"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+33 KILL T2,T4
SET T4="Airborne Precautions (Comment):"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+34 KILL T2,T4
SET T4="Neutropenic Precautions (Comment):"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+35 KILL T2,T4
SET T4="Radiation Precautions (Comment):"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+36 KILL T2,T4
SET T4="Standard Precautions (Comment):"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+37 KILL T2,T4
SET T4="Contact Enteric Precautions (Comment):"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+38 KILL T2,T4
SET T4="AFB Precautions (Comment):"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+39 KILL T2,T4
SET T4="Unknown Enter/Edit Plan"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+40 KILL T2,T4
SET T4="Plan:"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+41 KILL T2,T4
SET T4="CC Plan may include specialty and associated appt information, date of surgery post op needs, post d/c appointment and any other care coordination plan Plan: "
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+42 KILL T2,T4
SET T4="Enter/Edit Handoff Information "
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+43 KILL T2,T4
SET T4="The Veteran's assigned lead coordinator is"
SET T2(T4)=$CHAR(10)_T4
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+44 KILL T4,T2,T5
+45 QUIT
COMMON ;
+1 KILL T2
SET T2("Veteran Last Name: ")=$CHAR(160)_"Veteran Last Name: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+2 KILL T2
SET T2("Veteran First Name: ")=$CHAR(160)_"Veteran First Name: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+3 KILL T2
SET T2("Veteran Social:")=$CHAR(10)_"Veteran Social:"
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+4 KILL T2
SET T2("Date: ")=$CHAR(10)_"Date: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+5 KILL T2
SET T2($CHAR(160)_" Original CCP Note Date (mm/dd/yyyy): ")=$CHAR(160)_"Original CCP Note Date (mm/dd/yyyy): "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+6 KILL T2
SET T2("CCPN Number:"_$CHAR(160))=$CHAR(160)_"CCPN Number: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+7 KILL T2
SET T2("CONSULT AND REFERRAL INFORMATION")=$CHAR(160)_$CHAR(160)_"CONSULT AND REFERRAL INFORMATION"_$CHAR(160)
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+8 KILL T2
SET T2("Name of Referring VA Provider: ")=$CHAR(160)_"Name of Referring VA Provider: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+9 KILL T2
SET T2("Selected SEOC: ")=$CHAR(160)_"Selected SEOC: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+10 KILL T2
SET T2("Referral Number: ")=$CHAR(160)_"Referral Number: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+11 KILL T2
SET T2("Unique Consult ID: ")=$CHAR(160)_"Unique Consult ID: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+12 KILL T2,T4
SET T4="Patient Admitted (Yes/No): If yes, then please complete the Discharge Planning Addendum."
SET T2($GET(T4))=$CHAR(160)_$CHAR(160)_$GET(T4)
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+13 KILL T2,T4
SET T4=$CHAR(160)_" Please review all notes, this note may have one or more of the following addenda associated: "
SET T2($GET(T4))=$CHAR(10)_$GET(T4)
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+14 KILL T2
SET T2("Care Coordination Follow Up:"_$CHAR(160))=$CHAR(10)_"Care Coordination Follow Up: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+15 KILL T2
SET T2("Appointment Management: ")=$CHAR(10)_"Appointment Management: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+16 KILL T2
SET T2("Case Management: ")=$CHAR(160)_"Case Management: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+17 KILL T2
SET T2("Continued Stay Review: ")=$CHAR(160)_"Continued Stay Review: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+18 KILL T2
SET T2("Disease Management: ")=$CHAR(160)_"Disease Management: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+19 KILL T2
SET T2("Discharge Planning: ")=$CHAR(160)_"Discharge Planning: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+20 KILL T2
SET T2("Discharge Disposition: ")=$CHAR(160)_"Discharge Disposition: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+21 KILL T2
SET T2("Veteran Contact: ")=$CHAR(160)_"Veteran Contact: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+22 KILL T2
SET T2("Provider Contact: ")=$CHAR(160)_"Provider Contact: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+23 KILL T2
SET T2("Transfer: ")=$CHAR(160)_"Transfer: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+24 KILL T2
SET T2("Veteran Handoff:"_$CHAR(160))=$CHAR(160)_"Veteran Handoff: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+25 KILL T2
SET T2("FACILITY COMMUNITY CARE OFFICE CONTACT")=$CHAR(160)_$CHAR(160)_"FACILITY COMMUNITY CARE OFFICE CONTACT"_$CHAR(160)
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+26 KILL T2
SET T2("Care Coordination Point of Contact:"_$CHAR(160))=$CHAR(160)_"Care Coordination Point of Contact: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+27 KILL T2
SET T2("Phone Number: "_$CHAR(160))=$CHAR(160)_"Phone Number: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+28 ;K T2,T4 S T4=" "_$C(160)_" VETERAN'S"_$C(160)_"CAREGIVER"_$C(160)_"CONTACT INFO",T2(T4)=$C(160)_$C(160)_"X VETERAN'S CAREGIVER CONTACT INFOMATION"_$C(160)
+29 KILL T2,T4
SET T4="VETERAN'S CAREGIVER CONTACT INFO"
SET T2(T4)=$CHAR(10)_T4_$CHAR(10)
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+30 KILL T2,T4
SET T4="Is Veteran's caregiver same as next of kin listed in the demographic section of CPRS (Yes/No)?: If no, provide the following: "
SET T2($GET(T4))=$CHAR(160)_$GET(T4)
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+31 KILL T2
SET T2("Veteran's Caregiver Point of Contact: ")=$CHAR(160)_"Veteran's Caregiver Point of Contact: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+32 KILL T2
SET T2("Caregiver's Relationship to Veteran: ")=$CHAR(10)_"Caregiver's Relationship to Veteran: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+33 KILL T2
SET T2("Caregiver's Primary Phone Number: ")=$CHAR(10)_"Caregiver's Primary Phone Number: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+34 KILL T2
SET T2("PLAN:")=$CHAR(10)_$CHAR(10)_"PLAN: "_$CHAR(10)
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+35 KILL T2,T4
SET T4="*** CC Plan may include specialty and associated appointment information, date of surgery, post-op needs, post d/c appointment, and any other care coordination plan ***"
Begin DoDot:1
+36 SET T2=$GET(T4)=$CHAR(160)_$GET(T4)_$CHAR(160)
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
End DoDot:1
+37 KILL T2
SET T2("ADDITIONAL NOTES:")=$CHAR(160)_$CHAR(160)_"ADDITIONAL NOTES: "
SET WORDS=$$REPLACE^XLFSTR(WORDS,.T2)
+38 KILL T4,T2,T5
+39 QUIT
