Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BTIURPT

BTIURPT.m

Go to the documentation of this file. 
  1. BTIURPT ; IHS/ITSC/LJF - DRIVER TO VIEW PT'S DOCS ;
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
  1.  ;
  1. MAIN ;PEP -- main driver
  1.  ;can be called by other packages
  1.  ; if other package already has patient selected, set TIUZIHS=pat ien
  1.  ;
  1.  NEW TIUZVIEW,TIUZSORT,TIUZLT
  1.  ; -- ask user to pick browse mode
  1.  S TIUZVIEW=+$$READ^TIUU("NO^1:2","List (1) TEXT or (2) TITLES",2,"^D HELPVIEW^BTIURPT") Q:TIUZVIEW<1
  1.  ;
  1.  ; -- ask user to pick date sort
  1.  D MSG^BTIUU("",1,0,0)
  1.  S TIUZSORT=+$$READ^TIUU("NO^1:2","Sort by (1) VISIT DATE OR (2) REFERENCE DATE",1,"^D HELPSORT^BTIURPT") Q:TIUZSORT<1
  1.  ;
  1.  ; -- based on sort, call list template
  1.  S TIUZLT="BTIU "_$S(TIUZVIEW=1:"BROWSE BY ",1:"REVIEW BY ")_$S(TIUZSORT=1:"VISIT DATE",1:"REF DATE")
  1.  D EN^VALM(TIUZLT)
  1.  K TIULDT,TIUEDT,TIUZLN,TIUZCNT,TIUZIHS
  1.  Q
  1.  ;
  1.  ;
  1. HELPVIEW ;EP; -- help text for view by title or by text
  1.  D MSG^BTIUU(" 1 List by TEXT displays the actual document text for a series of documents.",2,0,0)
  1.  D MSG^BTIUU("    This assists in searching a series of notes for a specific word or phrase",1,0,0)
  1.  D MSG^BTIUU("    or to quickly browse all notes on a patient.",1,0,0)
  1.  D MSG^BTIUU(" 2 List by TITLE displays a patient's documents by title with author and",2,0,0)
  1.  D MSG^BTIUU("    diagnosis.  This assists in finding a particular document to read.",1,0,0)
  1.  Q
  1.  ;
  1. HELPSORT ;EP; -- help text for ref date vs. visit date question
  1.  D MSG^BTIUU(" 1 Visit Date is the visit or admission date to which a document",2,0,0)
  1.  D MSG^BTIUU("    linked.  This choice sorts by visit date then displays all documents",1,0,0)
  1.  D MSG^BTIUU("    for the visit, no matter when those documents were entered.",1,0,0)
  1.  D MSG^BTIUU(" 2 Reference Date is the date a document was either dictated or entered",2,0,0)
  1.  D MSG^BTIUU("    into the system.",1,0,0)
  1.  Q
  1.  ;
  1.  ;
  1. HDR ;EP; -- set up header for IHS browse by patient templates
  1.  NEW RANGE,NAME,DOCS K VALMHDR
  1.  S RANGE=" from "_$$FMTE^XLFDT(TIUEDT,2)_" to "_$$FMTE^XLFDT($P(TIULDT,"."),2)
  1.  S NAME=$$GET1^DIQ(2,$S($G(TIUZIHS):TIUZIHS,1:+$G(AUPNPAT)),.01)
  1.  S VALMHDR(1)=$$CENTER^TIULS("For "_NAME_RANGE)
  1.  S DOCS=$J(+$G(^TMP("TIUR",$J,0)),4)_" documents"
  1.  S VALMHDR(1)=$$SETSTR^VALM1(DOCS,VALMHDR(1),(IOM-$L(DOCS)),$L(DOCS))
  1.  Q
  1.  ;
  1.  ;
  1. EDIT ;EP; edit action from browse all menu
  1.  NEW BTIURPT S BTIURPT=1 D EDIT^TIURA,RESET Q
  1.  ;
  1. ADD ;EP; add action from browse all menu
  1.  I '$G(TIUZIHS) S TIUZIHS=$G(DFN) I '$G(TIUZIHS) D RESET Q
  1.  NEW BTIURPT S BTIURPT=1
  1.  ;D CLEAR^VALM1 D MAIN^BTIUEDIT(38,"",TIUZIHS),RESET Q
  1.  D CLEAR^VALM1 D ADD^TIURC,RESET Q
  1.  ;
  1. ADDEND ;EP; add addendum action from browse all menu
  1.  NEW BTIURPT S BTIURPT=1 D ADDEND^TIURA1,RESET Q
  1.  ;
  1. RESET ;EP; -- called to rebuild ^tmp and return to list template
  1.  I '$G(DFN) S DFN=$G(TIUZIHS) I 'DFN S VALMBCK="Q" Q
  1.  S TIUCLASS=38 K VALMY
  1.  D MSG^BTIUU("Updating Document List...Please Wait",1,0,0)
  1.  I TIUZLT="BTIU REVIEW BY REF DATE" D REBUILD("APT^"_DFN,1)
  1.  I TIUZLT="BTIU REVIEW BY VISIT DATE" D REBUILD("AIHS1^"_DFN,2)
  1.  I TIUZLT="BTIU BROWSE BY REF DATE" D REBUILD("APT^"_DFN,3)
  1.  I TIUZLT="BTIU BROWSE BY VISIT DATE" D REBUILD("AIHS1^"_DFN,4)
  1.  I TIUZLT="BTIU BROWSE H&P" S TIUCLASS=22 D REBUILD("AIHS1^"_DFN,4)
  1.  D HDR S VALMBCK="R",VALMSG=$$VALMSG^BTIUU
  1.  Q
  1. REBUILD(SORT,RTN) ;EP -- sets variables for rebuild after action performed
  1.  NEW STATUS,SCREEN,X
  1.  S STATUS=$$SELSTAT^TIULA(.TIUSTAT,"F","ALL")
  1.  I +STATUS<0 S VALMQUIT=1 Q
  1.  S SCREEN=1,SCREEN(1)=SORT
  1.  ;S TIUCLASS=3
  1.  S X="BUILD^BTIURPT"_RTN_"(.TIUSTAT,.TIUTYP,.SCREEN,TIUEDT,TIULDT)"
  1.  D @X
  1.  Q
  1.  ;
  1. VISIT(NOTE) ;EP; -- creates line of visit info
  1.  ; NOTE=ien of document
  1.  NEW VST,TIUZZ
  1.  S VST=$$GET1^DIQ(8925,NOTE,.03,"I") Q:VST=""
  1.  D ENP^XBDIQ1(9000010,VST,".01:.15","TIUZZ(","I")
  1.  Q
  1.  ;
  1. NOTES(NOTE,DTORDER) ;EP -- creates ^tmp("tiur" to display text of notes
  1.  ; -- TIUN=doc ien; DTORDER=type of date to print 1st (ref or visit)
  1.  NEW TYP,TIUZZ,LINE
  1.  D ENP^XBDIQ1(8925,NOTE,".01;.05;.06;1202;1208;1301","TIUZZ(","I")
  1.  S LINE=$$PAD($$DATE(1,DTORDER,NOTE),7)
  1.  S LINE=LINE_$$PAD($$DATE(2,DTORDER,NOTE),7) ;dates
  1.  S LINE=LINE_$$PAD($E($$DOCNM,1,24),26)   ;doc name
  1.  S LINE=LINE_$$PAD($$NAME^TIULS(TIUZZ(1202),"LAST, FI"),12) ;author
  1.  S:TIUZZ(1208)]"" LINE=LINE_"/"
  1.  S LINE=LINE_$$PAD($$NAME^TIULS(TIUZZ(1208),"LAST, FI"),12) ;cosigner
  1.  S LINE=LINE_$E(TIUZZ(.05),1,11)                  ;status
  1.  D TEXT(NOTE,LINE)
  1.  Q
  1.  ;
  1. TEXT(NOTE,LINE) ; -- sets array of note texts so user can display comments
  1.  NEW X
  1.  D SET2(LINE,NOTE,1)
  1.  ;D SET2(" "_$$REPEAT^XLFSTR("-",78),NOTE,0)
  1.  ;
  1.  S X=$$GET1^DIQ(8925,NOTE,.05)
  1.  I (X="UNSIGNED")!(X="UNCOSIGNED") D SET2($$UNSIG(NOTE,X),NOTE,0)
  1.  ;
  1.  I '$$CANDO^TIULP(NOTE,"VIEW") D  Q
  1.  . S X=$$SP(10)_"*** YOU MAY NOT VIEW THIS DOCUMENT ***"
  1.  . D SET2(X,NOTE,0),SET2(" ",NOTE,0)
  1.  ;
  1.  S X=0 F  S X=$O(^TIU(8925,NOTE,"TEXT",X)) Q:'X  D
  1.  . D SET2(^TIU(8925,NOTE,"TEXT",X,0),NOTE,0)
  1.  D SET2(" "_$$REPEAT^XLFSTR("=",78),NOTE,0)
  1.  D SET2(" ",NOTE,0)
  1.  Q
  1. SET2(LINE,IEN,NEW) ; -- SUBRTN to set data line into ^tmp for text
  1.  S TIUZLN=TIUZLN+1
  1.  S NUM=$S(NEW:$J(TIUCNT,2)_". ",1:$$SP(4))
  1.  S ^TMP("TIUR",$J,TIUZLN,0)=NUM_LINE
  1.  S ^TMP("TIUR",$J,"IDX",TIUZLN,TIUCNT)=IEN
  1.  I NEW D FLDCTRL^VALM10(TIUZLN,"NUMBER",IOINHI,IOINORM)
  1.  I NEW D FLDCTRL^VALM10(TIUZLN,"DOCUMENT",IOINHI,IOINORM)
  1.  Q
  1.  ;
  1. DATE(N,O,NOTE) ; -- returns readable date
  1.  I N=2 S O=$S(O="R":"V",1:"R") ;switch order for 2nd date
  1.  I O="R" Q $P($$FMTE^XLFDT(TIUZZ(1301,"I"),2),"/",1,2)
  1.  I O="V" Q $$VSTDT(NOTE)
  1.  Q ""
  1.  ;
  1. VST(NOT) ; -- returns ien for visit
  1.  Q $$GET1^DIQ(8925,NOT,.03,"I")
  1.  ;
  1. VSTDT(NOT) ;EP -- returns numdate of visit
  1.  Q $P($$FMTE^XLFDT($$GET1^DIQ(9000010,+$$VST(NOT),.01,"I"),2),"/",1,2)
  1.  ;
  1. VSTCAT(NOT) ;EP -- returns service category of visit
  1.  Q " "_$$GET1^DIQ(9000010,+$$VST(NOT),.07,"I")
  1.  ;
  1. VSTDX(NOT) ;EP -- returns prim dx for visit
  1.  NEW TIUX,TIUV,TIUZ
  1.  S TIUV=$$VST(NOT),TIUX=0
  1.  F  S TIUX=$O(^AUPNVPOV("AD",TIUV,TIUX)) Q:'TIUX!$G(TIUZ)  D
  1.  . I $$VSTCAT(NOT)="H" Q:$$GET1^DIQ(9000010.07,TIUX,.12,"I")'="P"
  1.  . S TIUZ=$$GET1^DIQ(9000010.07,TIUX,.04)
  1.  Q $G(TIUZ)
  1.  ;
  1. PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
  1.  Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
  1.  ;
  1. SP(NUM) ; -- SUBRTN to pad spaces
  1.  Q $$PAD(" ",NUM)
  1.  ;
  1. DOCNM() ; -- returns formatted document name
  1.  NEW DOC
  1.  S DOC=$$PNAME^TIULC1(TIUZZ(.01,"I"))
  1.  I DOC="Addendum" D
  1.  . S DOC=DOC_" to "_$$GET1^DIQ(8925,+TIUZZ(.06,"I"),.01)
  1.  I +$O(^TIU(8925,"DAD",+NOTE,0)),$$HASADDEN^TIULC1(NOTE) S DOC="+ "_DOC
  1.  S TIUP=$$URGENCY^BTIURPT3(+NOTE)
  1.  S:TIUP=1 DOC=$S(DOC["+":"*",1:"* ")_DOC
  1.  Q DOC
  1.  ;
  1. SRV(NOTE) ;EP; -- returns service of note based on visit
  1.  NEW ADDOK,VST,SRV,X
  1.  S ADDOK=$$ADDSRV(NOTE)=0 I ADDOK=0 Q ""
  1.  S VST=$$GET1^DIQ(8925,NOTE,.03,"I") I VST<1 Q ""
  1.  ;
  1.  ; -- clinic abbrev
  1.  S SRV=$$GET1^DIQ(9000010,VST,.08,"I")
  1.  I SRV Q $$GET1^DIQ(40.7,SRV,999999901)
  1.  ;
  1.  ; -- admit or disch serv abbrev
  1.  S X=$O(^AUPNVINP("AD",VST,0)) I 'X Q ""
  1.  S SRV=$$GET1^DIQ(9000010.02,X,$S(ADDOK=1:".06",1:".05"),"I")
  1.  Q $$GET1^DIQ(45.7,+SRV,99)
  1.  ;
  1. ADDSRV(NOTE) ;EP -- returns 1 if okay to add service to doc title
  1.  NEW X
  1.  S X=$$GET1^DIQ(8925,NOTE,.01,"I") I X="" Q 0
  1.  Q $$GET1^DIQ(8925.1,X,9999999.01,"I")
  1.  ;
  1. UNSIG(NOTE,STATUS) ;EP; -- returns unsigned note message
  1.  Q $$SP(5)_IOINHI_STATUS_" Document!"_$$AUTHOR(NOTE)_IOINORM
  1.  ;
  1. AUTHOR(NOTE) ; -- returns author name and class
  1.  Q " Author is "_$$TITLE(+$$GET1^DIQ(8925,NOTE,1202,"I"))
  1.  ;
  1. TITLE(USR) ; -- returns title for user
  1.  NEW IFN,TITLE
  1.  S IFN=0 F  S IFN=$O(^USR(8930.3,"B",USR,IFN)) Q:'IFN!($D(TITLE))  D
  1.  . Q:'$$GET1^DIQ(8930.3,IFN,9999999.01,"I")
  1.  . S TITLE=$$GET1^DIQ(8930.3,IFN,.02)
  1.  Q $G(TITLE)