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