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

BTIULO.m

Go to the documentation of this file. 
  1. BTIULO ; IHS/ITSC/LJF - CODE FOR IHS OBJECTS ;16-Sep-2013 15:45;DU
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**1001,1004,1006,1012**;NOV 04, 2004;Build 45
  1.  ;Added EHR 1.1 call for finding a visit
  1.  ;Added error message if visit not found
  1.  ;
  1. RELIGION(DFN) ;EP; Patient NAME
  1.  Q $$GET1^DIQ(2,DFN,.08)
  1.  ;
  1. SU(DFN) ;EP; Patient Service Unit of Residence
  1.  NEW X
  1.  S X=$$GET1^DIQ(9000001,DFN,1117,"I")
  1.  I X="" S X=$O(^AUPNPAT(DFN,51,""),-1) I X S X=$P(^AUPNPAT(DFN,51,X,0),U,3)
  1.  I X="" Q "??"
  1.  Q $$GET1^DIQ(9999999.05,+X,.05)
  1.  ;
  1. LASTDIFF(DFN,TYPE,VISIT) ;EP; returns last documnt of diff type for patient
  1.  ;IHS/ITSC/LJF 01/13/2005 PATCH 1001 - code added to accommodate calls from EHR
  1.  ; TYPE=Title IEN
  1.  ; if visit not sent, assume called by EHR and look for visit context
  1.  I '$G(VISIT) D  I $G(VISIT)<1 Q "Invalid visit "
  1.  . I $T(GETVAR^CIAVMEVT)="" S VISIT=0 Q
  1.  . NEW VST,X
  1.  . S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
  1.  . I VST="" S VISIT=0 Q
  1.  . S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S VISIT=VST Q
  1.  . ;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 Q
  1.  . S VISIT=VST
  1.  ;IHS/ITSC/LJF 01/13/2005 end of new code
  1.  ;
  1.  NEW DATE
  1.  S DATE=$$GET1^DIQ(9000010,VISIT,.01,"I") I DATE="" Q ""
  1.  S DATE=$O(^TIU(8925,"AA",DFN,TYPE,9999999-(DATE+1))) I DATE="" Q ""
  1.  Q $$FMTE^XLFDT(9999999-DATE,"1D")
  1.  ;
  1. AGE(DFN) ;EP; returns printable age
  1.  Q $$LOW^XLFSTR($$GET1^DIQ(9000001,DFN,1102.98)_" old")
  1.  ;
  1. PTED(VISIT) ;EP; returns all pat ed topics for visit
  1.  NEW TIUX,TIUY
  1.  S TIUX=0,TIUY="" F  S TIUX=$O(^AUPNVPED("AD",VISIT,TIUX)) Q:'TIUX  D
  1.  . S TIUY=TIUY_$$GET1^DIQ(9000010.16,TIUX,.01)_";"
  1.  Q $S(TIUY="":"",1:$P(TIUY_";",";;"))
  1.  ;
  1. TAXDX(DFN,TAXNM) ;EP; returns dx date and prov narrative
  1.  ; TAXNM=taxonomy name
  1.  NEW TAX,RDT,LINE,IEN,TIUR
  1.  S LINE="",TAX=$O(^ATXAX("B",TAXNM,0)) I TAX="" Q ""
  1.  S RDT=0 F  S RDT=$O(^AUPNVPOV("AA",DFN,RDT)) Q:'RDT!(LINE]"")  D
  1.  . S IEN=0 F  S IEN=$O(^AUPNVPOV("AA",DFN,RDT,IEN)) Q:'IEN!(LINE]"")  D
  1.  .. Q:'$$ICD^ATXCHK(+$G(^AUPNVPOV(IEN,0)),TAX,9)
  1.  .. K TIUR D ENP^XBDIQ1(9000010.07,IEN,".03;.04;.13;.17","TIUR(")
  1.  .. S LINE=$S(TIUR(.13)]"":TIUR(.13),TIUR(.17)]"":TIUR(.17),1:TIUR(.03))
  1.  .. S LINE=LINE_"   "_TIUR(.04)
  1.  Q LINE
  1.  ;
  1. TAXOP(DFN,TAXNM) ;EP; returns op/proc date and prov narrative
  1.  ; TAXNM=taxonomy name
  1.  NEW TAX,RDT,LINE,IEN,TIUR
  1.  S LINE="",TAX=$O(^ATXAX("B",TAXNM,0)) I TAX="" Q ""
  1.  S RDT=0 F  S RDT=$O(^AUPNVPRC("AA",DFN,RDT)) Q:'RDT!(LINE]"")  D
  1.  . S IEN=0 F  S IEN=$O(^AUPNVPRC("AA",DFN,RDT,IEN)) Q:'IEN!(LINE]"")  D
  1.  .. Q:'$$ICD^ATXCHK(+$G(^AUPNVPRC(IEN,0)),TAX,0)
  1.  .. K TIUR D ENP^XBDIQ1(9000010.08,IEN,".03;.04;.06","TIUR(")
  1.  .. S LINE=$S(TIUR(.06)]"":TIUR(.06),1:TIUR(.03))
  1.  .. S LINE=LINE_"   "_TIUR(.04)
  1.  Q LINE
  1.  ;
  1. NEXTAPPT(DFN) ;EP; returns patient's next appt
  1.  NEW DATE,YES,DATA,CLN,X,LINE,OI
  1.  K ^TMP("BTIULO",$J)
  1.  S DATE=$$NOW^XLFDT,YES=0
  1.  F  S DATE=$O(^DPT(DFN,"S",DATE)) Q:'DATE!(YES)  D
  1.  . S DATA=$G(^DPT(DFN,"S",DATE,0)) Q:DATA=""
  1.  . Q:$P(DATA,U,2)["C"  ;cancelled
  1.  . S X=0 F  S X=$O(^SC(+DATA,"S",DATE,1,X)) Q:'X  D
  1.  .. Q:+$G(^SC(+DATA,"S",DATE,1,X,0))'=DFN
  1.  .. S OI="  "_$P($G(^SC(+DATA,"S",DATE,1,X,0)),U,4)  ;other info
  1.  .. S YES=DATE_U_+DATA_U_OI
  1.  I 'YES Q "Next Appt:  None Found"
  1.  S LINE="Next Appt: "_$$FMTE^XLFDT(+YES,"1P")_" with "
  1.  S LINE=LINE_$$GET1^DIQ(44,$P(YES,U,2),.01)
  1.  S ^TMP("BTIULO",$J,1,0)=LINE,^TMP("BTIULO",$J,2,0)=OI
  1.  Q "~@^TMP(""BTIULO"",$J)"
  1.  ;
  1. FUTAPPT(DFN) ;EP; returns patient's future appts
  1.  NEW DATE,DATA,CLN,X,LN,CNT,OI
  1.  K ^TMP("BTIULO",$J)
  1.  S DATE=$$NOW^XLFDT,CNT=1
  1.  F  S DATE=$O(^DPT(DFN,"S",DATE)) Q:'DATE  D
  1.  . S DATA=$G(^DPT(DFN,"S",DATE,0)) Q:DATA=""
  1.  . Q:$P(DATA,U,2)["C"  ;cancelled
  1.  . S X=0 F  S X=$O(^SC(+DATA,"S",DATE,1,X)) Q:'X  D
  1.  .. Q:+$G(^SC(+DATA,"S",DATE,1,X,0))'=DFN
  1.  .. S OI=$$SP(10)_$P($G(^SC(+DATA,"S",DATE,1,X,0)),U,4)  ;other info
  1.  .. S LN=$$FMTE^XLFDT(+DATE,"1P")
  1.  .. S LN=LN_" ("_$P($G(^SC(+DATA,"S",DATE,1,X,0)),U,2)_" MINUTES)"
  1.  .. S LN=LN_" with "_$$GET1^DIQ(44,+DATA,.01)
  1.  .. S ^TMP("BTIULO",$J,CNT,0)=LN
  1.  .. S ^TMP("BTIULO",$J,CNT+1,0)=OI
  1.  .. S CNT=CNT+2
  1.  I '$D(^TMP("BTIULO",$J)) Q "Future Appt:  None Found"
  1.  Q "~@^TMP(""BTIULO"",$J)"
  1.  ;
  1. VLAB(VISIT,ABN) ;EP; returns all lab results given for a visit
  1.  ; ABN=1 means return abnormal results only (optional)
  1.  NEW TIUX,TIUY,COUNT,TIUA
  1.  K ^TMP("BTIULO",$J)
  1.  S TIUX=0,TIUY="" F  S TIUX=$O(^AUPNVLAB("AD",VISIT,TIUX)) Q:'TIUX  D
  1.  . K TIUA
  1.  . D ENP^XBDIQ1(9000010.09,TIUX,".01;.04;.05;1109","TIUA(")
  1.  . I TIUA(.04)="",TIUA(1109)="RESULTED" Q
  1.  . I $G(ABN),TIUA(.05)="" Q                  ;quit if abnormals only requested
  1.  . S TIUY="  "_$$PAD(TIUA(.01),25)_"  "      ;lab test
  1.  . S TIUY=TIUY_$$PAD(TIUA(.04),10)_TIUA(.05) ;result
  1.  . I TIUA(.04)="" S TIUY=TIUY_TIUA(1109)
  1.  . S COUNT=$G(COUNT)+1 S ^TMP("BTIULO",$J,COUNT,0)=TIUY
  1.  I '$D(^TMP("BTIULO",$J)) Q "No "_$S($G(ABN):"Abnormal ",1:"")_"Labs Found for Visit"
  1.  Q "~@^TMP(""BTIULO"",$J)"
  1.  ;
  1. VMED(VISIT) ;EP; returns all medications given for a visit
  1.  NEW TIUX,TIUY,COUNT
  1.  K ^TMP("BTIULO",$J)
  1.  S TIUX=0,TIUY="" F  S TIUX=$O(^AUPNVMED("AD",VISIT,TIUX)) Q:'TIUX  D
  1.  . S TIUY=TIUY_$$GET1^DIQ(9000010.14,TIUX,.01)_"; "
  1.  S:TIUY]"" TIUY=$$WRAP^TIULS(TIUY,73)
  1.  F COUNT=1:1 Q:$P(TIUY,"|",COUNT)=""  S ^TMP("BTIULO",$J,COUNT,0)=$P(TIUY,"|",COUNT)
  1.  I '$D(^TMP("BTIULO",$J)) Q "No Medications Found for Visit"
  1.  Q "~@^TMP(""BTIULO"",$J)"
  1.  ;
  1. VMEDEX(VISIT) ;EP; returns all medications given for a visit plus sig
  1.  NEW TIUX,TIUY,TIUCNT
  1.  K ^TMP("BTIULO",$J)
  1.  S (TIUCNT,TIUX)=0,TIUY=""
  1.  F  S TIUX=$O(^AUPNVMED("AD",VISIT,TIUX)) Q:'TIUX  D
  1.  . NEW BTIU D ENP^XBDIQ1(9000010.14,TIUX,".01;.05:.07","BTIU(")
  1.  . S TIUY=BTIU(.01)_" #"_BTIU(.06)_" ("_BTIU(.07)_" days)" D VMSET
  1.  . S TIUY=$$SIG(TIUX,BTIU(.05)) D VMSET
  1.  I '$D(^TMP("BTIULO",$J)) Q "No Medications Found for Visit"
  1.  Q "~@^TMP(""BTIULO"",$J)"
  1.  ;
  1. VMSET ; -- set string into wrapped line
  1.  NEW COUNT
  1.  S:TIUY]"" TIUY=$$WRAP^TIULS(TIUY,73)
  1.  F COUNT=1:1 Q:$P(TIUY,"|",COUNT)=""  D
  1.  . S TIUCNT=TIUCNT+1
  1.  . S ^TMP("BTIULO",$J,TIUCNT,0)=$P(TIUY,"|",COUNT)
  1.  Q
  1.  ;
  1. SIG(VMED,SSIG) ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG
  1.  ; VMED=ien in v med file; SSIG=short sig
  1.  NEW SIG,PIECE,Y,X
  1.  S SIG="" F PIECE=1:1:$L(SSIG," ") S X=$P(SSIG," ",PIECE) I X]"" D
  1.  . S Y=$O(^PS(51,"B",X,0)) I Y>0 S X=$P(^PS(51,Y,0),U,2) I $D(^(9)) S Y=$P(SSIG," ",PIECE-1),Y=$E(Y,$L(Y)) S:Y>1 X=$P(^(9),U,1)
  1.  . S SIG=SIG_X_" "
  1.  Q SIG
  1.  ;
  1. ALLERGY(DFN) ;EP; returns allergies and ADRs
  1.  NEW GMRA,GMRAL,X,ALLRG,ADR,TIUY,Y,Z
  1.  K ^TMP("BTIULO",$J)
  1.  S GMRA="0^0^111" D EN1^GMRADPT
  1.  I GMRAL=0 D  Q X
  1.  . S Z="Allergies/ADRs: "
  1.  . S Y=$O(GMRAL(0)) I Y S X=$P(GMRAL(Y),U,2) I X]"" S X=Z_X Q
  1.  . S X=Z_"None found in system"
  1.  S (ALLRG,ADR)=""
  1.  S X=0 F  S X=$O(GMRAL(X)) Q:'X  D
  1.  . I $P(GMRAL(X),U,5)=0 S ALLRG=ALLRG_$P(GMRAL(X),U,2)_"; " Q
  1.  . S ADR=ADR_$P(GMRAL(X),U,2)_"; "
  1.  S ALLRG=$S(ALLRG="":"None found",1:$P(ALLRG_";","; ;"))
  1.  S ADR=$S(ADR="":"None found",1:$P(ADR_";","; ;"))
  1.  S X="Allergies: "_ALLRG_";  ADRs: "_ADR S TIUY=$$WRAP^TIULS(X,73)
  1.  F COUNT=1:1 Q:$P(TIUY,"|",COUNT)=""  S ^TMP("BTIULO",$J,COUNT,0)=$P(TIUY,"|",COUNT)
  1.  Q "~@^TMP(""BTIULO"",$J)"
  1.  ;
  1.  ;
  1. UPDATE(DUZ,DFN,VISIT,TIUSUB) ;EP -- called to populate multiple objects
  1.  ; -- TIUSUB=subrtn for finding data
  1.  NEW TIUCNT
  1.  K ^TMP("BTIULO",$J)
  1.  I '$G(VISIT) Q ""  ;visit not set
  1.  D @TIUSUB
  1.  Q "~@^TMP(""BTIULO"",$J)"
  1.  ;
  1.  ;
  1. EDEVAL ; -- subrtn to find pat ed evaluations
  1.  NEW TIUX,TIUY,TIUZ,LINE
  1.  I '$O(^AUPNVPED("AD",VISIT,0)) S ^TMP("BTIULO",$J,1,0)="None Found" Q
  1.  ;
  1.  S TIUX=0,TIUY="",TIUCNT=1
  1.  F  S TIUX=$O(^AUPNVPED("AD",VISIT,TIUX)) Q:'TIUX  D
  1.  . D ENP^XBDIQ1(9000010.16,TIUX,".01;.05:.08","TIUZ(","I")
  1.  . S LINE=$$SP(2)_$$EDABBRV(TIUZ(.01,"I"))_": "_TIUZ(.08)_" min.; "
  1.  . S LINE=LINE_TIUZ(.07)_"; Understanding-"_TIUZ(.06)
  1.  . S ^TMP("BTIULO",$J,TIUCNT,0)=LINE
  1.  . S TIUCNT=TIUCNT+1
  1.  Q
  1.  ;
  1. EDABBRV(X) ; -- returns education topic abbreviation
  1.  Q $$GET1^DIQ(9999999.09,X,1)
  1.  ;
  1. HS(APCHSPAT,CODE,APCHSDLM) ;EP; -- calls HS component
  1.  ; CODE=entry point to call
  1.  NEW APCHSTYP,APCHSCKP,APCHSNPG,APCHSBRK,X,CNT,APCHSEGH
  1.  NEW APCHSEGL,APCHSCVD
  1.  K ^TMP("BTIULO",$J),^TMP("BTIU",$J)
  1.  I '$G(APCHSPAT) Q ""  ;patient not set
  1.  S APCHSCKP="Q:$D(APCHSQIT)",APCHSNPG=0
  1.  S APCHSBRK="D BREAK^APCHS",(APCHSEGH,APCHSEGL)=""
  1.  S X1=DT,X2=-APCHSDLM D C^%DTC S APCHSDLM=9999999-X K X1,X2
  1.  S APCHSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$S($E(Y,6,7):$E(Y,6,7)_""/"",1:"""")_($E(Y,1,3)+1700)"
  1.  ;
  1.  D GUIR^XBLM(CODE,"^TMP(""BTIU"",$J,")
  1.  D TERM^VALM0 D KILLHS
  1.  ;
  1.  S X=0 F  S X=$O(^TMP("BTIU",$J,X)) Q:'X  D
  1.  . I ^TMP("BTIU",$J,X)=""!(^(X)?1"--------".E) Q
  1.  . S CNT=$G(CNT)+1
  1.  . S ^TMP("BTIULO",$J,CNT,0)=^TMP("BTIU",$J,X)
  1.  Q "~@^TMP(""BTIULO"",$J)"
  1.  ;
  1. KILLHS ; kill health summary variables (copied from KILLS^APCHS0)
  1.  K APCHSCVD,APCHSICF,APCHSCKP,APCHSNPG,APCHSP,%,APCHSVAR,X,Y,APCHSQIT,APCHSHDR,APCHSHD2,APCHSBRK,APCHSPG
  1.  K APCHSEGN,APCHSEGC,APCHSEGT,APCHSEGH,APCHSEGL,APCHSEGP,APCHSDLM,APCHSDLS,APCHSNDM,APCHSN,APCHSQ
  1.  Q
  1.  ;
  1. PAD(D,L) ; -- SUBRTN to pad length of data
  1.  ; -- D=data L=length
  1.  Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
  1.  ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1.  Q $$PAD(" ",N)
  1.  ;
  1. DETAIL(DFN,TARGET) ;
  1.  N RXN,LP,LP2,LBL,CNT,Y,INIEN,REASON,X1,CAUSE
  1.  N GMRA,GMRAL,X,ALLRG,ADR,TIUY,Y,Z,CNT,UNI
  1.  K @TARGET
  1.  S CNT=0
  1.  S GMRA="0^0^111" D EN1^GMRADPT
  1.  I $D(GMRAL)'>9 D  G ADRX
  1.  . S CNT=+$G(CNT)+1
  1.  . I $D(GMRAL),GMRAL=0 S @TARGET@(CNT,0)="Patient has answered NKA"
  1.  . E  S @TARGET@(CNT,0)="No Allergy Assessment" ;
  1.  S ADR=0 F  S ADR=$O(GMRAL(ADR)) Q:ADR=""  D
  1.  .D EN1^GMRAOR2(ADR,"RXN")
  1.  .S UNI=$$UNI^BEHOARCV(ADR)   ;Get the UNI code for this agent if its GMR type
  1.  .I $L(UNI) S CAUSE=$P(RXN,U)_"; UNII: "_UNI
  1.  .E  S CAUSE=$P(RXN,U)
  1.  .S CNT=CNT+1
  1.  .S @TARGET@(CNT,0)="Causative agent: "_$P(CAUSE,U)
  1.  .S CNT=CNT+1
  1.  .S @TARGET@(CNT,0)="Event: "_$P(RXN,U,12)
  1.  .S CNT=CNT+1
  1.  .S @TARGET@(CNT,0)="Source: "_$P(RXN,U,11)
  1.  .D:$D(RXN("S",1)) SYM
  1.  .D:$D(RXN("I",1)) ING
  1.  .D:$D(RXN("V",1)) CLS
  1.  .D RECON(ADR)
  1.  .S CNT=CNT+1
  1.  .S @TARGET@(CNT,0)=""
  1. ADRX Q "~@"_$NA(@TARGET)
  1.  ;
  1. SYM ;Add symptoms
  1.  S CNT=CNT+1
  1.  S @TARGET@(CNT,0)="Signs/Symptoms:"
  1.  S LP=0 F  S LP=$O(RXN("S",LP)) Q:'LP  D
  1.  .S CNT=CNT+1
  1.  .S @TARGET@(CNT,0)="    "_RXN("S",LP)
  1.  Q
  1. CLS ;Add classes
  1.  S CNT=CNT+1
  1.  S @TARGET@(CNT,0)="Drug Classes:"
  1.  S LP=0 F  S LP=$O(RXN("V",LP)) Q:'LP  D
  1.  .S CNT=CNT+1
  1.  .S @TARGET@(CNT,0)="    "_$P(RXN("V",LP),U,2)
  1.  Q
  1. ING ;Add Ingredients
  1.  S CNT=CNT+1
  1.  S @TARGET@(CNT,0)="Drug Ingredients:"
  1.  S LP=0 F  S LP=$O(RXN("I",LP)) Q:'LP  D
  1.  .S CNT=CNT+1
  1.  .S @TARGET@(CNT,0)="    "_$P(RXN("I",LP),U,1)
  1.  Q
  1. RECON(ADR) ;Get reconciliation data
  1.  N REC,IEN,AIEN,WHEN,BY,FROM
  1.  S REC=""
  1.  F  S REC=$O(^BEHOCIR("G","A",ADR,REC)) Q:REC=""  D
  1.  .S IEN="" F  S IEN=$O(^BEHOCIR("G","A",ADR,REC,IEN)) Q:IEN=""  D
  1.  ..S AIEN=IEN_","_REC_","
  1.  ..S WHEN=$$GET1^DIQ(90461.632,AIEN,.01)
  1.  ..S BY=$$GET1^DIQ(90461.632,AIEN,.02)
  1.  ..S WHEN=WHEN_" by "_BY
  1.  ..S FROM=$$GET1^DIQ(90461.63,REC,.03)
  1.  ..S CNT=CNT+1
  1.  ..S @TARGET@(CNT,0)="Reconciled: "_WHEN
  1.  ..S CNT=CNT+1
  1.  ..S @TARGET@(CNT,0)="Data Source: "_FROM
  1.  Q