- 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)