TMGTIUOJ ;TMG/kst-Text objects for use in CPRS ;03/25/06 ;;1.0;TMG-LIB;**1**;03/12/09 ;"TMG text objects ;" ;"These are bits of code that return text to be included in progress notes etc. ;"They are called when the user puts text like this in a note: ;" ... Mrs. Jone's vitals today are |VITALS|, measured in the office... ;" 'VITALS' would be a TIU TEXT OBJECT, managed through menu option TIUFJ CREATE OBJECTS MGR ;"--------------------------------------------------------------------------- ;"PUBLIC FUNCTIONS ;"--------------------------------------------------------------------------- ;"$$VITALS(DFN,.TIU) ;"$$NICENAME(DFN) ;"$$FNAME(DFN) ;"$$MNAME(DFN) ;"$$LNAME(DFN) ;"$$PHONENUM(DFN) ;"$$GETTABLX(DFN,LABEL) ;"$$WTTREND(DFN,.TIU) return text showing patient's trend in change of weight. ;"$$WTDELTA(DFN,.TIU) return text showing patient's change in weight. ;"$$GETTABL1(DFN,LABEL) -- return a table from prior notes. ;"$$GETTABLX(DFN,LABEL) -- return a table compiled from prior notes. ;"--------------------------------------------------------------------------- ;"PRIVATE FUNCTIONS ;"--------------------------------------------------------------------------- ;"FormatVitals(result,s,Label,CurDT,NoteDT) ;"RemoveDT(S,DT) ;"RemoveTime(DT) ;"DateDelta(RefDT,DT) ;"FormatHeight(HtS,PtAge) remove centimeters from patient's height for adults ;"TMGVISDT(TIU) Return a string for date of visit ;"GetLast2(Array,NTLast,Last) Returns last 2 values in array (as created by GetPriorVital) ;"GetPriorVital(DFN,Date,Vital,Array) retrieve a list of prior vital entries for a patient ;"GetNotesList(DFN,List,IncDays) ;"ExtractSpecial(IEN8925,StartMarkerS,EndMarkerS,Array) ;"MergeInto(partArray,masterArray) ;"GetSpecial(DFN,StartMarkerS,EndMarkerS,Months,Array,Mode) ;"Array2Str(Array) convert Array (as created by GetSpecial) into one long string ;"AddIfAbsent(Array,Key,Pivot,Value) add one (empty) entry, if a value for this doesn't already exist. ;"StubRecommendations(DFN,Array,Label) add stubs for recommended studies to Array ;"--------------------------------------------------------------------------- ;"--------------------------------------------------------------------------- VITALS(DFN,TIU) ;"Purpose: Return a composite Vitals string like this: ;" T: 98.6 BP: 112/78 R: 17 P: 68 Wt.: 190 Ht.: 76 ;"Input: DFN -- the patient's unique ID (record#) ;" TIU -- this is an array created by TIU system that ;" contains information about the document being ;" edited/created. I believe it has this structure: ;" TIU("VSTR") = LOC;VDT;VTYP ;" TIU("VISIT") = Visit File IFN^date? ;" TIU("LOC") ;" TIU("VLOC") ;" TIU("STOP") = mark to defer workload ;" TIU("TYPE")=1^title DA^title Name i.e.: 1^128^OFFICE VISIT^OFFICE VISIT ;" TIU("SVC")=service, e.g. "FAMILY PRACTICE" ;" TIU("EDT")=TIUEDT^DateStr = event begin time: FMDate^DateStr ;" TIU("LDT")=TIULDT^DateStr = event end time: FMDate^DateStr ;" TIU("VSTR")=LOC;VDT;VTYP e.g. "x;x;OFFICE VISIT" ;" TIU("VISIT")=Visit File IFN ;" TIU("LOC")=TIULOC ;" TIU("VLOC")=TIULOC ;" TIU("STOP")=0 ;"0=FALSE, don't worry about stop codes. ;"Output: returns result new result set result="" new CurDT set CurDT="" new NoteDT set NoteDT="" new PtAge do . new IENS,TMGARRAY . set IENS=$get(DFN)_"," . do GETS^DIQ(2,IENS,.033,"TMGARRAY") ;".033 is computed patient age . set PtAge=+$get(TMGARRAY(2,IENS,.033)) ;"will return 0 if not found new Wt,Ht set NoteDT=$$VISDATE^TIULO1(.TIU) ;"Get date of current note (in MM/DD/YY HR:MIN) set NoteDT=$piece(NoteDT," ",1) ;"Drop time set CurDT=NoteDT ;"set result="Resp="_$$RESP^TIULO(+$get(DFN))_", " ;"set result="Pulse="_$$PULSE^TIULO(+$get(DFN))_", " do FormatVitals(.result,$$TEMP^TIULO(+$get(DFN)),"T",.CurDT,.NoteDT) do FormatVitals(.result,$$BP^TIULO(+$get(DFN)),"BP",.CurDT,.NoteDT) do FormatVitals(.result,$$RESP^TIULO(+$get(DFN)),"R",.CurDT,.NoteDT) do FormatVitals(.result,$$PULSE^TIULO(+$get(DFN)),"P",.CurDT,.NoteDT) set Wt=$$WEIGHT^TIULO(+$get(DFN)) set Ht=$$HEIGHT^TIULO(+$get(DFN)) set Ht=$$FormatHeight(Ht,.PtAge) do FormatVitals(.result,Wt,"Wt",.CurDT,.NoteDT,1) if (Wt'="")&(Ht'="") set result=result_$char(10)_$char(9) do FormatVitals(.result,Ht,"Ht",.CurDT,.NoteDT,1) ;"set result=result_";" ;temp!! ;"Now calculate BMI if Wt & Ht available ;" BMI=kg/meters^2 if (Wt'="")&(Ht'="") do . new sWt,sHt . new nWt,nHt,s1,BMI . set sWt=$$RemoveDT(Wt) . set sHt=$$RemoveDT(Ht) . set s1=$piece(sWt,"[",2) ;"convert '200 lb [91.2 kg]' --> '91.2 kg]' . set nWt=+$piece(s1," ",1) ;"convert '91.2 kg]' --> 91.2 . set s1=$piece(sHt,"[",2) ;"convert '56 in [130 cm]' --> '130 cm]' . set nHt=+$piece(s1," ",1) ;"convert '130 cm]' --> 130 . set nHt=nHt/100 ;"convert centimeters to meters . if nHt>0 do . . new tempBMI,iBMI,Digit . . new MSqr set MSqr=(nHt*nHt) . . set tempBMI=(nWt/MSqr) . . set Digit=(((tempBMI-(tempBMI\1))*10)\1)/10 . . set BMI=(tempBMI\1)+Digit . . do FormatVitals(.result,BMI,"BMI",.CurDT) . . if BMI<18.5 do . . . set result=result_" (<18.5 = ""UNDER-WT"")" . . else if BMI<25.01 do . . . set result=result_" (18.5-25 = ""HEALTHY"")" . . else if BMI<30.01 do . . . set result=result_" (25-30 = ""OVER-WT"")" . . else if BMI<40.01 do . . . set result=result_" (30-40 = ""OBESE"")" . . else do . . . set result=result_" (>40 = ""VERY OBESE"")" . . new idealLb1,idealLb2 . . set idealLb1=((18.5*MSqr)*2.2)\1 . . set idealLb2=((25*MSqr)*2.2)\1 . . set result=result_$char(10)_$char(9)_"(Ideal Wt="_idealLb1_"-"_idealLb2_" lbs" . . if Wt>idealLb2 set result=result_"; "_(Wt-idealLb2)_" lbs over weight)" . . else if Wt0)&($get(NoteDT)'="")&($get(ForceShow)'=1) quit ;"If NoteDT specified, don't allow delta>0 . . if (result'="")&($extract(result,$length(result))'=$char(9)) set result=result_", " . . set CurDT=DT . . if (Delta>0)&(DT'="") set result=result_"("_DT_") " . . set result=result_Label_" "_s FVDone quit RemoveDT(S,DT) ;"Purpose: to remove a date-Time string, and return in DT ;" i.e. turn this: ;" 127/56 (12/25/04 16:50) ;" into these: ;" '127/56' and '12/25/04 16:50' ;"Input: S -- a string as above ;" DT -- [Optional] an OUT parameter... must PASS BY REFERENCE ;"result: returns input string with (date-time) removed ;" Date-Time is returned in DT if passed by reference. new result set result=$get(S) if result="" goto RDTDone set result=$piece(S,"(",1) set result=$$Trim^TMGSTUTL(.result) set DT=$piece(S,"(",2) set DT=$piece(DT,")",1) set DT=$$Trim^TMGSTUTL(.DT) quit result RDTDone quit result RemoveTime(DT) ;"Purpose: to remove the time from a date/time string ;"Input: DT -- the date/time string, i.e. '2/24/05 16:50' ;"result: returns just the date, i.e. '2/25/05' new result set result=$piece(DT," ",1) quit result FormatHeight(HtS,PtAge) ;"Purpose: to remove centimeters from patient's height for adults ;"Input: Ht, a height string, e.g. '74 in [154 cm]' ;" PtAge, patient's age in years ;"Result: returns patient height, with [154 cm] removed, if age > 16 new result set result=$get(HtS) if $get(PtAge)'<16 do . set result=$piece(HtS,"[",1) quit result DateDelta(RefDT,DT) ;"Purpose: To determine the number of days between DT and now ;" i.e. How many days DT was before RefDT. ;"Input:RefDT -- a reference/baseline date/time string ;" if not supplied, Current date/time used as default. ;" DT -- a date/time string (i.e. '12/25/04 16:50') ;"Result: Return number of days between DT and RefDT ;" Positive numbers used when DT occured before current date ;" i.e. result=RefDT-DT new iNowDT,iRefDT,iDT ;internal format of dates new result set result=0 ;"write "DT='",DT,"'",! ;"set iDT=$$IDATE^TIULC(.DT) ;"Convert date into internal ;"write "iDT=",iDT,! set X=DT do ^%DT set iDT=Y ;"Convert date into internal if $get(RefDT)="" set iRefDT=$$DT^XLFDT else set X=RefDT do ^%DT set iRefDT=Y ;"Convert date into internal ;"write "iDT=",iDT,! ;"set iNowDT=$$DT^XLFDT ;"write "iNowDT=",iNowDT,! ;"set result=$$FMDIFF^XLFDT(iNowDT,iDT) set result=$$FMDIFF^XLFDT(iRefDT,iDT) quit result TMGVISDT(TIU) ; Visit date ;"Purpose: Return a string for date of visit ;"Note: This is based on the function VISDATE^TIULO1(TIU) ;" However, that function seemed to return the appointment date associated ;" with a note, rather than the specified date of the note ;" Also, this will return date only--not time. ;"Input: TIU -- this is an array created by TIU system that ;" contains information about the document being ;" edited/created. I believe it has this this structure: ;" TIU("VSTR") = LOC;VDT;VTYP ;" TIU("VISIT") = Visit File IFN^date? ;" TIU("LOC") ;" TIU("VLOC") ;" TIU("STOP") = mark to defer workload ;" TIU("TYPE")=1^title DA^title Name i.e.: 1^128^OFFICE VISIT^OFFICE VISIT ;" TIU("SVC")=service, e.g. "FAMILY PRACTICE" ;" TIU("EDT")=TIUEDT^DateStr = event begin time: FMDate^DateStr ;" TIU("LDT")=TIULDT^DateStr = event end time: FMDate^DateStr ;" TIU("VSTR")=LOC;VDT;VTYP e.g. "x;x;OFFICE VISIT" ;" TIU("VISIT")=Visit File IFN ;" TIU("LOC")=TIULOC ;" TIU("VLOC")=TIULOC ;" TIU("STOP")=0 ;"0=FALSE, don't worry about stop codes. ;"Output: returns result N TIUX,TIUY new result ;set result="VISIT="_$get(TIU("VISIT"))_" " ;set result=result_"VSTR="_$get(TIU("VSTR"))_" " ;set result=result_"EDT="_$get(TIU("EDT"))_" " ;set result=result_"LDT="_$get(TIU("LDT"))_" " if $get(TIU("VISIT"))'="" do . set result=$piece(TIU("VISIT"),U,2) else if $get(TIU("VSTR"))'="" do . set result=$piece(TIU("VSTR"),";",2) else do . set result="(Visit Date Unknown)" if +result>0 do . set result=$$DATE^TIULS(result,"MM/DD/YY HR:MIN") . set result=$piece(result," ",1) ;"cut off time. VDDone quit result FNAME(DFN) ;"Purpose: Return Patient's first name ;"Input: DFN -- the patient's unique ID (record#) ;"Output: returns result new name set name=$piece($get(^DPT(DFN,0)),"^",1) set name=$piece(name,",",2) set name=$piece(name," ",1) set name=$$CapWords^TMGSTUTL(name) quit name MNAME(DFN) ;"Purpose: Return Patient's middle name(s) ;"Input: DFN -- the patient's unique ID (record#) ;"Output: returns result new name set name=$piece($get(^DPT(DFN,0)),"^",1) set name=$piece(name,",",2) set name=$piece(name," ",2,100) set name=$$CapWords^TMGSTUTL(name) quit name LNAME(DFN) ;"Purpose: Return Patient's last name ;"Input: DFN -- the patient's unique ID (record#) ;"Output: returns result new name set name=$piece($get(^DPT(DFN,0)),"^",1) set name=$piece(name,",",1) set name=$$CapWords^TMGSTUTL(name) quit name NICENAME(DFN) ;"Purpose: Return Patient's name format: Firstname Middlename Lastname ;" only the first letter of each name capitalized. ;"Input: DFN -- the patient's unique ID (record#) ;"Output: returns result new name set name=$piece($get(^DPT(DFN,0)),"^",1) set name=$piece(name,",",2)_" "_$piece(name,",",1) ;"put first name first set name=$$CapWords^TMGSTUTL(name) quit name PHONENUM(DFN) ;"Purpose: to return the patient's phone number ;"Input: DFN -- the patient's unique ID (record#) ;"Output: returns result new result set result="" if +$get(DFN)=0 goto PNDone set result=$$GET1^DIQ(2,DFN_",",.131) set result=$translate(result," ","") if $length(result)=10 do . new temp set temp=result . set result="("_$extract(result,1,3)_") "_$extract(result,4,6)_"-"_$extract(result,7,10) if $length(result)=7 do . new temp set temp=result . set result=$extract(result,1,3)_"-"_$extract(result,4,7) PNDone quit result ;"------------------------------------------------------------- ;"------------------------------------------------------------- WTTREND(DFN,TIU) ;"Purpose: return text showing patient's trend in change of weight. ;" e.g. 215 <== 212 <== 256 <== 278 ;"Input: DFN=the Patient's IEN in file #2 ;" TIU=PASS BY REFERENCE. Should be an Array of TIU note info ;" See documentation in VITALS(DFN,TIU) ;"Results: Returns string describing changes in weight. new result set result="" new Date set Date=$get(TIU("EDT")) if +Date'>0 do . set result="(No wts available)" . goto WTTRDone new Array do GetPriorVital(.DFN,Date,"WEIGHT",.Array) new Date set Date="" for set Date=$order(Array(Date),-1) quit:(+Date'>0) do . if result'="" set result=result_" <== " . set result=result_$order(Array(Date,"")) set result="Wt trend: "_result WTTRDone quit result WTDELTA(DFN,TIU) ;"Purpose: return text showing patient's change in weight. ;"Input: DFN=the Patient's IEN in file #2 ;" TIU=PASS BY REFERENCE. Should be an Array of TIU note info ;" See documentation in VITALS(DFN,TIU) ;"Results: Returns string describing change in weight. new result set result="Weight " new delta new Date set Date=$get(TIU("EDT")) ;"Episode date if +Date'>0 do goto WTDDone . set result=result_"change: ?" new Array do GetPriorVital(.DFN,Date,"WEIGHT",.Array) new NTLast,Last do GetLast2(.Array,.NTLast,.Last) set Last=+Last set NTLast=+NTLast set delta=Last-NTLast if delta>0 set result=result_"up "_delta_" lbs. " else if delta<0 set result=result_"down "_-delta_" lbs. " else do . if Last=0 set result=result_"change: ?" quit . set result=result_"unchanged. " if (Last>0)&(NTLast>0) do . set result=result_"("_Last_" <== "_NTLast_" prior wt)" WTDDone quit result GetLast2(Array,NTLast,Last) ;"Purpose: Returns last 2 values in array (as created by GetPriorVital) ;"Input: Array -- PASS BY REFERENCE. Array as created by GetPriorVital ;" Array(FMDate,Value)="" ;" Array(FMDate,Value)="" ;" NTLast --PASS BY REFERENCE, an OUT PARAMETER. ;" Next-To-Last value in array list (sorted by ascending date) ;" Last -- PASS BY REFERENCE, an OUT PARAMETER. ;" Last value in array list (sorted by ascending date) ;"Results: None new NTLastDate,LastDate set LastDate="" set LastDate=$order(Array(""),-1) set Last=$order(Array(LastDate,"")) set NTLastDate=$order(Array(LastDate),-1) set NTLast=$order(Array(NTLastDate,"")) quit GetPriorVital(DFN,Date,Vital,Array) ;"Purpose: To retrieve a list of prior vital entries for a patient ;" Note: entries up to *AND INCLUDING* the current day will be retrieved ;"Input: DFN: the IEN of the patient, in file #2 (PATIENT) ;" Date: Date (in FM format) of the current event. Entries up to ;" AND INCLUDING this date will be retrieved. ;" Vital: Vital to retrieve, GMRV VITAL TYPE file (#120.51) ;" Must be .01 value of a valid record ;" E.g. "ABDOMINAL GIRTH","BLOOD PRESSURE","HEIGHT", etc. ;" Array: PASS BY REFERENCE, an OUT PARAMETER. Prior values killed. Format as below. ;"Output: Array is filled as follows: ;" Array(FMDate,Value)="" ;" Array(FMDate,Value)="" ;" Or array will be empty if no values found. ;"Result: None if +$get(DFN)=0 goto GPVDone if +$get(Date)=0 goto GPVDone if $get(Vital)="" goto GPVDone new VitalTIEN set VitalTIEN=+$order(^GMRD(120.51,"B",Vital,"")) if VitalTIEN'>0 goto GPVDone kill Array new IEN set IEN="" new X,X1,X2,%Y for set IEN=$order(^GMR(120.5,"C",DFN,IEN)) quit:(+IEN'>0) do . new s set s=$get(^GMR(120.5,IEN,0)) . if +$piece(s,"^",3)'=VitalTIEN quit . set X1=Date . set X2=+$piece(s,"^",1) . do ^%DTC ;"date delta . if %Y'=1 quit ;"data unworkable . if X>-1 set Array(+$piece(s,"^",1),+$piece(s,"^",8))="" GPVDone quit ;"------------------------------------------------------------- ;"------------------------------------------------------------- GetNotesList(DFN,List,IncDays) ;"Purpose: Return a list of notes for patient in given time span ;"Input: DFN -- IEN in PATIENT file (the patient record number) ;" List -- PASS BY REFERENCE, an OUT PARAMETER. (Format below) ;" IncDays -- Number of DAYS to search in. ;" E.g. 4 --> get notes from last 4 days ;"Output: List format: ;" List(FMTimeOfNote,IEN8925)="" ;" List(FMTimeOfNote,IEN8925)="" ;" List(FMTimeOfNote,IEN8925)="" ;" If no notes found, then array is left blank. Prior entries KILLED ;"Results: none kill List set DFN=+$get(DFN) if DFN'>0 goto GNLDone set IncDays=+$get(IncDays) new temp,i merge temp=^TIU(8925,"C",DFN) set IEN="" for set IEN=$order(temp(IEN)) quit:(IEN="") do . new X,X1,X2,%Y,StartDate . do NOW^%DTC set X1=X . set StartDate=$piece($get(^TIU(8925,IEN,0)),"^",7) . set X2=StartDate . do ^%DTC ;"calculate X=X1-X2. Returns #days between . if X>IncDays quit . set List(StartDate,IEN)="" GNLDone quit IsHTML(IEN8925) ;"Purpose: to specify if the text held in the REPORT TEXT field is HTML markup ;"Input: IEN8925 -- record number in file 8925 ;"Results: 1 if HTML markup, 0 otherwise. ;"Note: This is not a perfect test. Also, will fail if tag is not uppercase ; new result set result=0 new Done set Done=0 new line set line=0 for set line=$order(^TIU(8925,IEN8925,"TEXT",line)) quit:(line="")!Done do . new lineS set lineS=$get(^TIU(8925,IEN8925,"TEXT",line,0)) . if (lineS["") set Done=1,result=1 quit quit result HTML2TXT(Array) ;"Purpose: text a WP array that is HTML formatted, and strip

, and ;" return in a format of 1 line per array node. ;"Input: Array -- PASS BY REFERENCE. This array will be altered. ;"Results: none ;"NOTE: This conversion causes some loss of HTML tags, so a round trip ;" conversion back to HTML would fail. new outArray,outI set outI=1 ;"Clear out confusing non-breaking spaces. new spec set spec(" ")=" " set spec("<")="<" set spec(">")=">" set spec("&")="&" set spec(""")="""" new line set line=0 for set line=$order(Array(line)) quit:(line="") do . new lineS set lineS=$get(Array(line,0)) . set Array(line,0)=$$REPLACE^XLFSTR(lineS,.spec) new s2 set s2="" new line set line=0 for set line=$order(Array(line)) quit:(line="") do . new lineS set lineS=s2_$get(Array(line,0)) . set s2="" . for do quit:(lineS'["<") . . if (lineS["

")&($piece(lineS,"

",1)'["
") do quit . . . set outArray(outI,0)=$piece(lineS,"

",1) . . . set outI=outI+1 . . . set outArray(outI,0)="" ;"Add blank line to create paragraph break. . . . set outI=outI+1 . . . set lineS=$piece(lineS,"

",2,999) . . if (lineS["

")&($piece(lineS,"

",1)'["
") do quit . . . set outArray(outI,0)=$piece(lineS,"

",1) . . . set outI=outI+1 . . . set outArray(outI,0)="" ;"Add blank line to create paragraph break. . . . set outI=outI+1 . . . set lineS=$piece(lineS,"

",2,999) . . if (lineS["")&($piece(lineS,"",1)'["
") do quit . . . set outArray(outI,0)=$piece(lineS,"",1) ;" _"" . . . set outI=outI+1 . . . set outArray(outI,0)="" ;"Add blank line to create paragraph break. . . . set outI=outI+1 . . . set lineS=$piece(lineS,"",2,999) . . if lineS["
" do quit . . . set outArray(outI,0)=$piece(lineS,"
",1) . . . set outI=outI+1 . . . set lineS=$piece(lineS,"
",2,999) . . set s2=lineS,lineS="" . set s2=s2_lineS if s2'="" do . set outArray(outI,0)=s2 . set outI=outI+1 kill Array merge Array=outArray quit ExtractSpecial(IEN8925,StartMarkerS,EndMarkerS,Array) ;"Purpose: To scan the REPORT TEXT field in given document and return ;" paragraph of text that is started by StartMarkerS, and ended by EndMarkerS. ;" I.E. Search for a line that contains MarkerS. Return that line and ;" all following lines until line found with EndMarkerS, or ;" end of text. ;"Input: IEN8925 -- IEN in file 8925 (TIU DOCUMENT) ;" StartMarkerS -- the string to search for that indicates start of block ;" EndMarkerS -- the string to search for that indicates the end of block. ;" NOTE: if EndMarkerS="BLANK_LINE", then search is ;" ended when a blank line is encountered. ;" Array -- PASS BY REFERENCE, an OUT PARAMETER. Prior values killed. ;" Format: Array(0)=MaxLineCount ;" Array(1)="Text line 1" ;" Array(2)="Text line 2" ... ;"Result: 1 if data found, otherwise 0 new result set result=0 kill Array set IEN8925=+$get(IEN8925) if IEN8925'>0 goto ESDone if $data(^TIU(8925,IEN8925,"TEXT"))'>0 goto ESDone if $get(StartMarkerS)="" goto ESDone if $get(EndMarkerS)="" goto ESDone new ref set ref=$name(^TIU(8925,IEN8925,"TEXT")) new tempArray if $$IsHTML(IEN8925) do . merge tempArray=^TIU(8925,IEN8925,"TEXT") . do HTML2TXT(.tempArray) . set ref="tempArray" new line,i,BlockFound,Done set line=0,i=0,BlockFound=0,Done=0 for set line=$order(@ref@(line)) quit:(line="")!Done do . new lineS set lineS=$get(@ref@(line,0)) . if (BlockFound=0) do quit ;"don't include header line with output . . if lineS[StartMarkerS set BlockFound=1 . if (BlockFound=1) do . . set i=i+1,Array(0)=i . . new s2 set s2=$$Trim^TMGSTUTL(lineS," ") . . set s2=$$Trim^TMGSTUTL(s2,$char(9)) . . set Array(i)=lineS . . if s2="" set Array(i)=s2 . . set result=1 . . if (EndMarkerS="BLANK_LINE")&(s2="") set BlockFound=0,Done=1 quit . . if lineS[EndMarkerS set BlockFound=0,Done=1 quit ;"include line with END marker ESDone quit result MergeInto(partArray,masterArray) ;"Purpose: to combine partArray into MasterArray. ;"Input: partArray -- PASS BY REFERENCE ;" masterArray -- PASS BY REFERENCE ;"Note: Arrays are combine in a 'transparent' manner such that newer entries ;" will overwrite older entries only for identical values. For example: ;" -- BLOCK -- <--- MasterArray ;" TSH = 1.56 ;" LDL = 140 ;" -- END BLOCK -- ;" ;" -- BLOCK -- <--- partArray ;" LDL = 150 ;" -- END BLOCK -- ;" ;" The above two blocks will result in this final array ;" -- BLOCK -- ;" TSH = 1.56 ;" LDL = 150 <--- this value overwrote older entry ;" -- END BLOCK -- ;" ;" In this mode, only data that is in a LABEL <--> VALUE format ;" will be checked for newer vs older entries. All other ;" lines will simply be included in one large summation block. ;" And the allowed format for LABEL <--> VALUE will be: ;" Label = value or ;" Label : value ;" ;"Output: MasterArray will be filled as follows: ;" Array("text line")="" ;" Array("text line")="" ;" Array("KEY-VALUE",KeyName)=Value ;" Array("KEY-VALUE",KeyName,"LINE")=original line new lineNum set lineNum=0 for set lineNum=$order(tempArray(lineNum)) quit:(+lineNum'>0) do . new line set line=$get(tempArray(lineNum)) . if (line["=")!(line[":") do . . new key,shortKey,value,pivot . . if line["=" set pivot="=" . . else set pivot=":" . . set key=$piece(line,pivot,1) . . set shortKey=$$UP^XLFSTR($$Trim^TMGSTUTL(key)) . . set value=$piece(line,pivot,2,999) . . set Array("KEY-VALUE",shortKey)=value . . set Array("KEY-VALUE",shortKey,"LINE")=line . else do . . if line="" quit . . set Array(line)="" quit GetSpecial(DFN,StartMarkerS,EndMarkerS,Months,Array,Mode) ;"Purpose: to return a block of text from notes for patient, starting with ;" StartMarkerS, and ending with EndMarkerS, searching backwards ;" within time period of 'Months'. ;"Input: DFN -- IEN of patient in PATIENT file. ;" StartMarkerS -- the string to search for that indicates start of block ;" EndMarkerS -- the string to search for that indicates the end of block. ;" NOTE: if EndMarkerS="BLANK_LINE", then search is ;" ended when a blank line is encountered. ;" Months -- Number of Months to search in. ;" E.g. 4 --> search in notes from last 4 months ;" Array -- PASS BY REFERENCE. an OUT PARAMETER. Old values killed. Format below ;" Mode: operation mode. As follows: ;" 1 = return only block from most recent match ;" 2 = compile all. ;" In this mode, the search is carried out from oldest to most ;" recent, and newer blocks overlay older ones in a 'transparent' ;" manner such that newer entries will overwrite older entries ;" only for identical values. For example: ;" -- BLOCK -- <--- from date 1/1/1980 ;" TSH = 1.56 ;" LDL = 140 ;" -- END BLOCK -- ;" ;" -- BLOCK -- <--- from date 2/1/1980 ;" LDL = 150 ;" -- END BLOCK -- ;" ;" The above two blocks will result in this final block ;" -- BLOCK -- ;" TSH = 1.56 ;" LDL = 150 <--- this value overwrote older entry ;" -- END BLOCK -- ;" ;" In this mode, only data that is in a LABEL <--> VALUE format ;" will be checked for newer vs older entries. All other ;" lines will simply be included in one large summation block. ;" And the allowed format for LABEL <--> VALUE will be: ;" Label = value or ;" Label : value ;" ;"Output: Array will be filled as follows: ;" Array("text line")="" ;" Array("text line")="" ;" Array("KEY-VALUE",KeyName)=Value ;" Array("KEY-VALUE",KeyName,"LINE")=original line ;"Results: none new NotesList kill Array set DFN=+$get(DFN) if DFN'>0 goto GSDone new IncDays set IncDays=+$get(Months)*30 do GetNotesList(DFN,.NotesList,IncDays) new direction set direction=1 if Mode=1 set direction=-1 new Done set Done=0 new StartTime set StartTime="" for set StartTime=$order(NotesList(StartTime),direction) quit:(StartTime="")!Done do . new IEN8925 set IEN8925="" . for set IEN8925=$order(NotesList(StartTime,IEN8925),direction) quit:(+IEN8925'>0)!Done do . . new tempArray . . if $$ExtractSpecial(IEN8925,.StartMarkerS,.EndMarkerS,.tempArray)=1 do . . . do MergeInto(.tempArray,.Array) . . . if Mode=1 set Done=1 GSDone quit Array2Str(Array) ;"Purpose: to convert Array (as created by GetSpecial) into one long string ;"Input: Array. Format as follows: ;" Array("text line")="" ;" Array("text line")="" ;" Array("KEY-VALUE",KeyName)=Value ;" Array("KEY-VALUE",KeyName,"LINE")=original line new result set result="" new keyName set keyName="" ;"First, put in key-value lines for set keyName=$order(Array("KEY-VALUE",keyName)) quit:(keyName="") do . new line . set line=$get(Array("KEY-VALUE",keyName,"LINE")) . if result'="" set result=result_$char(13)_$char(10) . set result=result_line kill Array("KEY-VALUE") ;"Next, put standard lines new line set line="" for set line=$order(Array(line)) quit:(line="") do . if result'="" set result=result_$char(13)_$char(10) . set result=result_line quit result AddIfAbsent(Array,Key,Pivot,Value) ;"Purpose: to add one (empty) entry, if a value for this doesn't already exist. ;"Input: Array. Format as follows: ;" Array("text line")="" ;" Array("text line")="" ;" Array("KEY-VALUE",KeyName)=Value ;" Array("KEY-VALUE",KeyName,"LINE")=original line ;" Key -- the name of the study ;" Pivot -- ":", or "=" OPTIONAL. Default = ":" ;" Value -- the description of the needed value. OPTIONAL. ;" default value = '' set Pivot=$get(Pivot,":") set Value=$get(Value,"") if $get(Key)="" goto AIADone new UpKey set UpKey=$$UP^XLFSTR(Key) if $data(Array("KEY-VALUE",UpKey))>0 goto AIADone set Array("KEY-VALUE",UpKey)=$get(Value) new line set line=" "_$get(Key)_" "_$get(Pivot)_" "_$get(Value) set Array("KEY-VALUE",UpKey,"LINE")=line AIADone quit StubRecommendations(DFN,Array,Label) ;"Purpose: to add stubs for recommended studies to Array ;"Get age from DFN if +$get(DFN)=0 goto SRDone new Age set Age=+$$GET1^DIQ(2,DFN,.033) new Sex set Sex=$$GET1^DIQ(2,DFN,.02) if Label="[STUDIES]" do . if (Sex="FEMALE") do . . if (Age>39) do AddIfAbsent(.Array,"Mammogram") . . if (Age>59) do AddIfAbsent(.Array,"Bone Density") . . if (Age>18) do AddIfAbsent(.Array,"Pap") . . if (Age>8)&(Age<27) do AddIfAbsent(.Array,"Gardasil",":","#1 ; #2 ; #3 ") . if (Sex="MALE")&(Age>49) do AddIfAbsent(.Array,"PSA") . if Age>64 do AddIfAbsent(.Array,"Pneumovax") . do AddIfAbsent(.Array,"Flu Vaccine") . if (Age>18) do AddIfAbsent(.Array,"Advance Directives") . ;"if (Age>49) do AddIfAbsent(.Array,"Td") . if (Age>59) do AddIfAbsent(.Array,"Zostavax") . if (Age>1)&(Age<19) do AddIfAbsent(.Array,"MMR",":","#1 ; #2 ") . if (Age>0)&(Age<21) do AddIfAbsent(.Array,"Hep B",":","#1 ; #2 ; #3 ") . if (Age>1)&(Age<19) do AddIfAbsent(.Array,"Hep A",":","#1 ; #2 ") . if (Age>1)&(Age<21) do AddIfAbsent(.Array,"Varivax",":","#1 ; #2 ") . if (Age>10)&(Age<65) do AddIfAbsent(.Array,"TdaP / Td") . if (Age>10)&(Age<23) do AddIfAbsent(.Array,"MCV4 (Menactra)") . if (Age>50) do AddIfAbsent(.Array,"Colonoscopy") else if Label="[DIABETIC STUDIES]" do . do AddIfAbsent(.Array,"HgbA1c","=") . do AddIfAbsent(.Array,"Diabetic Eye Exam") . do AddIfAbsent(.Array,"Urine Microalbumin") . do AddIfAbsent(.Array,"Diabetic Foot Exam") . do AddIfAbsent(.Array,"EKG") . do AddIfAbsent(.Array,"Regimen") else if Label="[LIPIDS]" do . do AddIfAbsent(.Array,"Total Cholesterol","=") . do AddIfAbsent(.Array,"LDL Cholesterol","=") . do AddIfAbsent(.Array,"HDL Cholesterol","=") . do AddIfAbsent(.Array,"Triglycerides","=") . do AddIfAbsent(.Array,"Date of last lipid panel") . do AddIfAbsent(.Array,"LDL Goal") . do AddIfAbsent(.Array,"Liver Enzymes") . do AddIfAbsent(.Array,"Regimen") else if Label="[SOCIAL]" do . do AddIfAbsent(.Array,"Tobacco") . do AddIfAbsent(.Array,"EtOH") else if Label="[THYROID]" do . do AddIfAbsent(.Array,"Date of last study") . do AddIfAbsent(.Array,"TSH","=") . do AddIfAbsent(.Array,"Regimen") else if Label="[HYPERTENSION]" do . do AddIfAbsent(.Array,"Date of last electrolytes") . do AddIfAbsent(.Array,"EKG") . do AddIfAbsent(.Array,"Med-1") else if Label="[ANEMIA]" do . do AddIfAbsent(.Array,"Hgb") . do AddIfAbsent(.Array,"Serum Fe") . do AddIfAbsent(.Array,"TIBC") . do AddIfAbsent(.Array,"B12") . do AddIfAbsent(.Array,"Folate") . do AddIfAbsent(.Array,"Workup") else if Label="[ASTHMA]" do . do AddIfAbsent(.Array,"Peak Flow Personal Best") . do AddIfAbsent(.Array,"Meds") . do AddIfAbsent(.Array,"Rescue Inhaler Freq") . do AddIfAbsent(.Array,"Pneumovax") . do AddIfAbsent(.Array,"Triggers") . do AddIfAbsent(.Array,"Smoker") . do AddIfAbsent(.Array,"Nocturnal Symptoms") else if Label="[COPD]" do . do AddIfAbsent(.Array,"Meds") . do AddIfAbsent(.Array,"Rescue Inhaler Freq") . do AddIfAbsent(.Array,"Pneumovax") . do AddIfAbsent(.Array,"Pulmonologist") . do AddIfAbsent(.Array,"Home O2") . do AddIfAbsent(.Array,"PFT Testing") . do AddIfAbsent(.Array,"Tobacco Cessation Counselling") else if Label="[OSTEOPENIA/OSTEOPOROSIS]" do . do AddIfAbsent(.Array,"Bone Density") . do AddIfAbsent(.Array,"T-Score Spine/Hips") . do AddIfAbsent(.Array,"Regimen") . do AddIfAbsent(.Array,"Advised Calcium ~1500 mg & Vit-D 1000-2000 IU") SRDone quit GETTABL1(DFN,LABEL) ;"Purpose: A call point for TIU objects, to return a table comprised from 1 prior table. ;"NOTE: This type of table just gets the *LAST* table found (not a compilation) GT1 new Array,result set result="" if $get(LABEL)="" goto GT1Done set result=" -- "_LABEL_" ---------"_$CHAR(13)_$CHAR(10) do GetSpecial(DFN,LABEL,"BLANK_LINE",48,.Array,1) ;"mode 1 = only last table; 2=compile do StubRecommendations(.DFN,.Array,LABEL) set result=result_$$Array2Str(.Array) GT1Done quit result GETTABLX(DFN,LABEL) ;"Purpose: A call point for TIU objects, to return a table comprised from prior notes. ;"NOTE: This compiles a table from all prior matching tables in date range. goto GT1 ;"<-- Hack to force TableX to really be a Table1 type table. new Array,result set result="" if $get(LABEL)="" goto GTXDone set result=" -- "_LABEL_" ---------"_$CHAR(13)_$CHAR(10) do GetSpecial(DFN,LABEL,"BLANK_LINE",13,.Array,2) ;"mode 1 = only last table; 2=compile do StubRecommendations(.DFN,.Array,LABEL) set result=result_$$Array2Str(.Array) GTXDone quit result