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

BTIUPCC5.m

Go to the documentation of this file.
  1. BTIUPCC5 ; IHS/CIA/MGH - IHS PCC PERSONAL HEALTH OBJECTS ;06-Jan-2016 12:14;DU
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**1005,1006,1009,1012,1016**;NOV 04, 2004;Build 10
  1. ;This routine creates objects for the personal health
  1. ;data entered
  1. ;Patch 1006 changed the data in the V asthma lookup
  1. ;Patch 1009 changed the functional assessment to use entry date
  1. ;Patch 1012 changed for SNOMED
  1. ;==============================================================
  1. INFANT(DFN,TARGET) ;EP
  1. ; Infant feeding data
  1. N DATA,ARRAY,FNUM,CNT,RESULT,DATE,ENTRY,ADD,IENS,IEN,X
  1. S FNUM=9000010.44,CNT=0,ENTRY=""
  1. D VFGET^BGOUTL2(.ARRAY,DFN,FNUM,".03;.01;1201")
  1. F S ENTRY=$O(@ARRAY@(ENTRY)) Q:+ENTRY'>0 D
  1. .S CNT=CNT+1
  1. .S DATA=$G(@ARRAY@(ENTRY))
  1. .S IEN=$P(DATA,U,1)
  1. .S RESULT=$P($P(DATA,U,4),"|",1)
  1. .S DATE=$P($P(DATA,U,5),"|",1)
  1. .I DATE="" S DATE=$P($P(DATA,U,3),"|",1)
  1. .S @TARGET@(CNT,0)=$P(DATE,"@",1)_" "_RESULT
  1. .;ADDITIONAL FEEDING CHOICES
  1. .S ADD=0 F S ADD=$O(^AUPNVIF(IEN,13,ADD)) Q:ADD'=+ADD D
  1. ..S IENS=ADD_","_IEN
  1. ..S X=$$GET1^DIQ(9000010.4413,IENS,.01)
  1. ..I X'="" D
  1. ...S CNT=CNT+1
  1. ...I $P($G(^AUPNVIF(IEN,13,ADD,0)),U,2)]"" S X=X_" COMMENT: "_$$GET1^DIQ(9000010.4413,IENS,.02)
  1. ...S @TARGET@(CNT,0)=" "_X
  1. I CNT=0 S @TARGET@(1,0)="No infant feeding data on file"
  1. Q "~@"_$NA(@TARGET)
  1. FUNC(DFN,TARGET,ITEMS) ;EP
  1. ;Functional assessment
  1. N DATA,ARRAY,ARRAY2,IDATE,FNUM,CNT,RESULT,DATE,ENTRY,EDATE,FIEN,CHECK,LEN
  1. S FNUM=9000010.35,CNT=0,ENTRY=""
  1. D VFGET^BGOUTL2(.ARRAY,DFN,FNUM,".03;.04;.05;.06;.07;.08;.09;.11;.12;.13;.14;.15;.16;.17;.18")
  1. F S ENTRY=$O(@ARRAY@(ENTRY)) Q:+ENTRY'>0!(CNT>ITEMS) D
  1. .S CNT=CNT+1
  1. .S DATA=$G(@ARRAY@(ENTRY))
  1. .S FIEN=$P(DATA,U,1)
  1. .S EDATE=9999999-$P($G(^AUPNVELD(FIEN,12)),U,1)
  1. .S ARRAY2(EDATE)=DATA
  1. S CNT=0
  1. S IDATE="" F S IDATE=$O(ARRAY2(IDATE)) Q:IDATE="" D
  1. .S CNT=CNT+1
  1. .S DATA=$G(ARRAY2(IDATE))
  1. .S DATE=9999999-IDATE S DATE=$$FMTE^XLFDT(DATE)
  1. .S @TARGET@(CNT,0)="Assessment Date:"_DATE
  1. .S CNT=CNT+1
  1. .S CHECK=$P($P(DATA,U,16),"|",1)
  1. .S @TARGET@(CNT,0)=" Status Change: "_$$PAD(CHECK,17)_" Caregiver: "_$P($P(DATA,U,17),"|",1)
  1. .S CNT=CNT+1
  1. .S CHECK=$P($P(DATA,U,4),"|",1)
  1. .S @TARGET@(CNT,0)=" Toileting: "_$$PAD(CHECK,17)_" Finances: "_$P($P(DATA,U,10),"|",1)
  1. .S CNT=CNT+1
  1. .S CHECK=$P($P(DATA,U,5),"|",1)
  1. .S @TARGET@(CNT,0)=" Bathing: "_$$PAD(CHECK,17)_" Cooking: "_$P($P(DATA,U,11),"|",1)
  1. .S CNT=CNT+1
  1. .S CHECK=$P($P(DATA,U,6),"|",1)
  1. .S @TARGET@(CNT,0)=" Dressing: "_$$PAD(CHECK,17)_" Shopping: "_$P($P(DATA,U,12),"|",1)
  1. .S CNT=CNT+1
  1. .S CHECK=$P($P(DATA,U,7),"|",1)
  1. .S @TARGET@(CNT,0)=" Transfers: "_$$PAD(CHECK,17)_" Housework: "_$P($P(DATA,U,13),"|",1)
  1. .S CNT=CNT+1
  1. .S CHECK=$P($P(DATA,U,8),"|",1)
  1. .S @TARGET@(CNT,0)=" Feeding: "_$$PAD(CHECK,17)_" Medications: "_$P($P(DATA,U,14),"|",1)
  1. .S CHECK=$P($P(DATA,U,9),"|",1)
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)=" Continence: "_$$PAD(CHECK,17)_" Transportation: "_$P($P(DATA,U,15),"|",1)
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)=""
  1. I CNT=0 S @TARGET@(1,0)="No functional assessment on file"
  1. Q "~@"_$NA(@TARGET)
  1. BMEA(DFN,TARGET) ;EP
  1. ;Birth Measurement data
  1. N DATA,ARRAY,FNUM,CNT,RESULT,DATE,ENTRY,I
  1. S FNUM=9000024,CNT=0,ENTRY=""
  1. S DATA=""
  1. D GET^BGOBMSR(.DATA,DFN)
  1. I DATA="" S @TARGET@(1,0)="No birth measurement data" Q "~@"_$NA(@TARGET)
  1. F I=1:1:14 I $P(DATA,U,I)="" S $P(DATA,U,I)="Unknown"
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="Birth Weight: "_$P(DATA,U,1)_" lbs "_$P(DATA,U,2)_" oz "_$P(DATA,U,4)_" grams"
  1. S CNT=CNT+1
  1. ;S @TARGET@(CNT,0)="Apgar: "_$P(DATA,U,5)_" 1 MIN "_$P(DATA,U,6)_" 5 MIN"
  1. ;S CNT=CNT+1
  1. ;S @TARGET@(CNT,0)="Gestational Age: "_$P(DATA,U,7)_" Del Type: "_$P(DATA,U,8)
  1. ;S CNT=CNT+1
  1. ;S @TARGET@(CNT,0)="Complications: "_$P(DATA,U,9)_" Birth Order: "_$P(DATA,U,10)
  1. ;S CNT=CNT+1
  1. S @TARGET@(CNT,0)="Formula Started: "_$P(DATA,U,11)_" Solids Started: "_$P(DATA,U,13)
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="Breast Stopped: "_$P(DATA,U,12)
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="Mother: "_$P($P(DATA,U,14),"|",1)
  1. S CNT=CNT+1
  1. Q "~@"_$NA(@TARGET)
  1. REF(DFN,TARGET,NUM) ;EP
  1. ;Refusals
  1. N REFIEN,CNT,TYPE,REASON
  1. S REFIEN="",CNT=0,ARRAY=""
  1. F S REFIEN=$O(^AUPNPREF("AC",DFN,REFIEN),-1) Q:REFIEN="" D
  1. .S ARRAY=$$REFGET1^BGOUTL2(REFIEN)
  1. .S CNT=CNT+1
  1. .S REASON=$P(ARRAY,U,13) I REASON="" S REASON=$P(ARRAY,U,11)
  1. .S @TARGET@(CNT,0)=$P(ARRAY,U,6)_" "_$P(ARRAY,U,9)_" Type: "_$P(ARRAY,U,4)_" Reason: "_REASON
  1. I CNT=0 S @TARGET@(1,0)="No refusals found on file"
  1. Q "~@"_$NA(@TARGET)
  1. ASTHMA(DFN,TARGET) ;EP
  1. ;Asthma Data
  1. N DATA,ARRAY,FNUM,CNT,RESULT,DATE,ENTRY
  1. S FNUM=9000010.41,CNT=0,ENTRY=""
  1. D VFGET^BGOUTL2(.ARRAY,DFN,FNUM,".03;.14;.08;.09;.11;")
  1. F S ENTRY=$O(@ARRAY@(ENTRY)) Q:+ENTRY'>0 D
  1. .S CNT=CNT+1
  1. .S DATA=$G(@ARRAY@(ENTRY))
  1. .S DATE=$P($P(DATA,U,3),"|",1)
  1. .S @TARGET@(CNT,0)="Assessment Date: "_DATE
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)=" Asthma Control: "_$P($P(DATA,U,4),"|",1)
  1. .S CNT=CNT+1
  1. .;S @TARGET@(CNT,0)=" FEV 1: "_$P($P(DATA,U,5),"|",1)_" FEV 25-75: "_$P($P(DATA,U,6),"|",1)
  1. .;S CNT=CNT+1
  1. .;S @TARGET@(CNT,0)=" Particulate Matter: "_$P($P(DATA,U,10),"|",1)_" Dust Mites: "_$P($P(DATA,U,11),"|",1)
  1. .;S CNT=CNT+1
  1. .;S @TARGET@(CNT,0)=" Asthma Management Plan: "_$P($P(DATA,U,11),"|",1)
  1. I CNT=0 S @TARGET@(1,0)="No asthma data on file"
  1. Q "~@"_$NA(@TARGET)
  1. PAIN(DFN,TARGET) ;EP
  1. ;Pain Contract
  1. N DATA,ARRAY,FNUM,CNT,TYPE,DATE,ENTRY,PROVIDER
  1. S FNUM=9000010.39,CNT=0,ENTRY=""
  1. D VFGET^BGOUTL2(.ARRAY,DFN,FNUM,".03;.01;.04;.05")
  1. F S ENTRY=$O(@ARRAY@(ENTRY)) Q:+ENTRY'>0 D
  1. .S CNT=CNT+1
  1. .S DATA=$G(@ARRAY@(ENTRY))
  1. .S TYPE=$P($P(DATA,U,4),"|",1)
  1. .S DATE=$P($P(DATA,U,5),"|",1)
  1. .S PROVIDER=$P($P(DATA,U,6),"|",1)
  1. .S @TARGET@(CNT,0)="Contract Type: "_TYPE
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)="Date Initiated: "_DATE_" Provider: "_PROVIDER
  1. I CNT=0 S @TARGET@(1,0)="No pain contract on file"
  1. Q "~@"_$NA(@TARGET)
  1. ER(DFN,TARGET) ;EP
  1. ;ER data
  1. N CNT,VST,ERIEN
  1. S CNT=0
  1. S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
  1. I VST="" S @TARGET@(1,0)="No visit selected" Q "~@"_$NA(@TARGET)
  1. S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="A visit was not created." Q "~@"_$NA(@TARGET)
  1. S ERIEN="" S ERIEN=$O(^AMERVSIT("AD",VST,ERIEN)) D
  1. .I ERIEN'="" D GETDATA(ERIEN,.CNT,.TARGET)
  1. .I ERIEN="" S @TARGET@(1,0)="No ER visits for this encounter"
  1. Q "~@"_$NA(@TARGET)
  1. LASTER(DFN,TARGET) ;EP
  1. N CNT,FOUND,IEN,VST
  1. S FOUND=0
  1. S CNT=0
  1. S IEN="" S IEN=$O(^AMERVSIT("AC",DFN,IEN),-1) D
  1. .I IEN'="" D GETDATA(IEN,.CNT,.TARGET)
  1. .I IEN="" S @TARGET@(1,0)="No ER visits on file"
  1. Q "~@"_$NA(@TARGET)
  1. GETDATA(ERIEN,CNT,TARGET) ;Get the data for the visit
  1. N DATA,ARRAY,FNUM,RESULT,DATE,ENTRY,X,DEPART,TRANS,VST,X,INP,ERIENS
  1. N TRG,TRGNU,ACUITY,CLIN,INJ,TRANS,VST,FOUND
  1. S FNUM=9009080
  1. S ERIENS=ERIEN_","
  1. D GETS^DIQ(FNUM,ERIENS,"**","IE","ARRAY","ERR")
  1. ;Check in data
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="ADMISSION INFORMATION"
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="Check-In: "_$G(ARRAY(FNUM,ERIENS,.01,"E"))
  1. ;Format the presenting complaint
  1. S COMM="Presenting Complaint: "_$G(ARRAY(FNUM,ERIENS,1,"E"))
  1. D COMMENTS(COMM)
  1. S TRG=$G(ARRAY(FNUM,ERIENS,12.1,"E"))
  1. S TRGNU=$G(ARRAY(FNUM,ERIENS,.07,"E"))
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="Triage Time: "_TRG_" Triage Nurse: "_TRGNU
  1. S ACUITY=$G(ARRAY(FNUM,ERIENS,.24,"E"))
  1. S CLIN=$G(ARRAY(FNUM,ERIENS,.04,"E"))
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="Clinic: "_CLIN_" Initial Acuity: "_ACUITY
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)=$$STRING^BTIULO16()
  1. ;Injury data
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="INJURY INFORMATION"
  1. S CNT=CNT+1
  1. S INJ=$G(ARRAY(FNUM,ERIENS,3.1,"E"))
  1. S @TARGET@(CNT,0)="Was this visit caused by an injury: "_INJ
  1. I INJ="YES" D
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)="Injury Occurered: "_$G(ARRAY(FNUM,ERIENS,3.4,"E"))_" Work Related: "_$G(ARRAY(FNUM,ERIENS,2.1,"E"))
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)="Injury Cause: "_$G(ARRAY(FNUM,ERIENS,3.2,"E"))
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)="Where Injury Occurred: "_$G(ARRAY(FNUM,ERIENS,3.3,"E"))
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)="Safety Equipment: "_$G(ARRAY(FNUM,ERIENS,3.5,"E"))
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)=$$STRING^BTIULO16()
  1. ;VISIT DATA
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="VISIT INFORMATION"
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="Primary Nurse: "_$G(ARRAY(FNUM,ERIENS,6.4,"E"))
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="Medical Screening Exam Time: "_$G(ARRAY(FNUM,ERIENS,12.1,"E"))
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="ED Provider: "_$G(ARRAY(FNUM,ERIENS,.06,"E"))
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="Decision to Admit Time: "_$G(ARRAY(FNUM,ERIENS,12.8,"E"))
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="ER Consult Notified: "_$G(ARRAY(FNUM,ERIENS,.22,"E"))
  1. ;Get consults
  1. I $D(^AMERVSIT(ERIEN,19))>0 D CONSULT(ERIEN)
  1. ;Get procedures
  1. I $D(^AMERVSIT(ERIEN,4))>0 D PROC(ERIEN)
  1. ;Get Dxs
  1. I $D(^AMERVSIT(ERIEN,5))>0 D DXS(ERIEN)
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)=$$STRING^BTIULO16()
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="DISPOSITION INFORMATION"
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="Final Acuity: "_$G(ARRAY(FNUM,ERIENS,5.4,"E"))
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="Disposition: "_$G(ARRAY(FNUM,ERIENS,6.1,"E"))
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="Disch Prov: "_$G(ARRAY(FNUM,ERIENS,6.3,"E"))_" Disch Nurse: "_$G(ARRAY(FNUM,ERIENS,6.4,"E"))
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="Departure Time: "_$G(ARRAY(FNUM,ERIENS,6.2,"E"))
  1. S CNT=CNT+1
  1. S TRANS=$G(ARRAY(FNUM,ERIENS,6.6,"E"))
  1. I TRANS'="" D
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)="Transferred to: "_TRANS
  1. S COMM="Disch Instruction: "_$G(ARRAY(FNUM,ERIENS,7,"E"))
  1. D COMMENTS(COMM)
  1. Q
  1. COMMENTS(COMM) ;Add in fields that can be 245 characters
  1. N MAXLEN,TXT2,SUBCOUNT,SUBLINE
  1. S MAXLEN=62
  1. I $L(COMM)>MAXLEN D
  1. .S TXT2=$$WRAP^TIULS(COMM,MAXLEN)
  1. .F SUBCOUNT=1:1 S SUBLINE=$P(TXT2,"|",SUBCOUNT) Q:SUBLINE="" D ADD2(SUBLINE)
  1. E D ADD2(COMM)
  1. ;
  1. ADD2(TXT) ;
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)=TXT
  1. Q
  1. CONSULT(ERIEN) ;Get the consults for this visit
  1. N SIEN,NODE,CONS,PRV
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="CONSULTS"
  1. S SIEN=0 F S SIEN=$O(^AMERVSIT(ERIEN,19,SIEN)) Q:'+SIEN D
  1. .S NODE=$G(^AMERVSIT(ERIEN,19,SIEN,0))
  1. .S CONS=$P($G(^AMER(2.9,$P(NODE,U,1),0)),U,1)
  1. .S PRV=$P($G(^VA(200,$P(NODE,U,3),0)),U,1)
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)=" "_CONS_" Provider: "_PRV
  1. Q
  1. PROC(ERIEN) ;Get the procedures for this visit
  1. N SIEN,NODE,PROC
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="PROCEDURES"
  1. S SIEN=0 F S SIEN=$O(^AMERVSIT(ERIEN,4,SIEN)) Q:'+SIEN D
  1. .S PROC=$G(^AMERVSIT(ERIEN,4,SIEN,0))
  1. .S PROC=$$GET1^DIQ(9009083,PROC,.01)
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)=" "_PROC
  1. Q
  1. DXS(ERIEN) ;Get the Dxs for this visit
  1. N SIEN,NODE,DX,NARR
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)="DIAGNOSES"
  1. S SIEN=0 F S SIEN=$O(^AMERVSIT(ERIEN,5,SIEN)) Q:'+SIEN D
  1. .S DX=$G(^AMERVSIT(ERIEN,5,SIEN,0))
  1. .S NARR=$G(^AMERVSIT(ERIEN,5,SIEN,1))
  1. .S DX=$$GET1^DIQ(80,DX,.01)
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)=" "_DX_" "_NARR
  1. Q
  1. PAD(D,L,C) ;EP
  1. ;---> Pad the length of data to a total of L characters
  1. ;---> by adding spaces to the end of the data.
  1. ; Example: S X=$$PAD("MIKE",7) X="MIKE " (Added 3 spaces.)
  1. ;---> Parameters:
  1. ; 1 - D (req) Data to be padded.
  1. ; 2 - L (req) Total length of resulting data.
  1. ; 3 - C (opt) Character to pad with (default=space).
  1. ;
  1. Q:'$D(D) ""
  1. S:'$G(L) L=$L(D)
  1. S:$G(C)="" C=" "
  1. Q $E(D_$$REPEAT^XLFSTR(C,L),1,L)