BTIUPCC7 ; IHS/MSC/MGH - IHS PCC PERSONAL HEALTH OBJECTS ;28-Jun-2017 14:15;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1008,1009,1013,1018**;NOV 04, 2004;Build 4
;This routine creates objects for the personal health
;data entered
;Patch 1018 added ER admission objects
;==============================================================
CVD(DFN,TARGET) ;EP
N ARRAY,CNT,I,J
S CNT=1
D PAT^BQITRPHS(DFN,.ARRAY)
I $P(ARRAY(0),U,1)=1 S @TARGET@(CNT,0)=$P(ARRAY(0),U,2)
E S @TARGET@(CNT,0)="Patient does not have an iCare Diagnostic Tag of CVD"
S I=0 F S I=$O(ARRAY(I)) Q:I="" D
.S CNT=CNT+1 S @TARGET@(CNT,0)=""
.S J=0 F S J=$O(ARRAY(I,J)) Q:J="" D
..S CNT=CNT+1
..S @TARGET@(CNT,0)=$G(ARRAY(I,J,0))
Q "~@"_$NA(@TARGET)
LABRES(DFN,TIUTST,TIUCNT) ;EP; -- returns last # of current lab result for single
; TIUTST = lab test name; TIUCNT = # of test results to return
;IHS/CIA/MGH Modified to only display the test name and results
NEW LAB,CAPTION,VDT,DATE,IEN,X,TIU,LINE,CNT,DATA,LGTH,DATE,Y,ARR
K ^TMP("BTIULOX",$J)
S LAB=$O(^LAB(60,"B",TIUTST,0)) I LAB="" Q ""
S CAPTION=$E(TIUTST,1,30)_":"
S (VDT,CNT)=0,ARR=""
F S VDT=$O(^AUPNVLAB("AA",DFN,LAB,VDT)) Q:('VDT)!(CNT=TIUCNT) D
. S IEN=0
. F S IEN=$O(^AUPNVLAB("AA",DFN,LAB,VDT,IEN)) Q:'IEN!(CNT=TIUCNT) D
.. K TIU D ENP^XBDIQ1(9000010.09,IEN,".03:.05;1109;1201","TIU(","I")
.. Q:TIU(.04)="" ;skip if not resulted
.. S CNT=CNT+1 ;increment counter
.. S DATE=$S(TIU(1201,"I")]"":TIU(1201,"I"),1:$$GET1^DIQ(9000010,TIU(.03,"I"),.01,"I"))
.. S ARR(DATE,IEN)=$J(TIU(.04),8)_" "_TIU(.05),CNT=CNT+1
S CNT=0,DATE=""
F S DATE=$O(ARR(DATE),-1) Q:DATE=""!(CNT>=TIUCNT) D
. S IEN="" F S IEN=$O(ARR(DATE,IEN),-1) Q:'IEN!(CNT>=TIUCNT) D
. . S LINE=$G(ARR(DATE,IEN)),CNT=CNT+1
. . S Y=$S(CNT=1:CAPTION,1:$$SP($L(CAPTION)))
. . S ^TMP("BTIULOX",$J,CNT,0)=Y_LINE
I '$D(^TMP("BTIULOX",$J)) S ^TMP("BTIULOX",$J,1,0)="No Results Found"
Q "~@^TMP(""BTIULOX"",$J)"
SP(NUM) ; -- SUBRTN to pad spaces
Q $$PAD(" ",NUM)
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
PHISTORY(DFN,TARGET) ;Return personal history data
N DATA,BTIU,IEN,FNUM,CNT,RESULT,DATE,LINE,NUM,ONSET,ENTRY
S FNUM=9000013,CNT=0,ENTRY="",ONSET=""
S IEN=0 F S IEN=$O(^AUPNPH("AC",DFN,IEN)) Q:'IEN D
.S CNT=$G(CNT)+1,NUM=$G(NUM)+1
.K BTIU D ENP^XBDIQ1(9000013,IEN,".01;.02:.07;","BTIU(","I")
.S LINE=$J(NUM,2)_") "_$G(BTIU(.04))_" Noted: "_$G(BTIU(.03))
.I $G(BTIU(.05))'="" S LINE=LINE_" Onset: "_$G(BTIU(.05))
.S @TARGET@(CNT,0)=LINE
I CNT=0 S @TARGET@(1,0)="No personal history on file"
Q "~@"_$NA(@TARGET)
GVISIT(DFN) ;Retrieve VIEN
;
NEW X,VIEN
;
;Check for CIA
I $T(GETVAR^CIAVMEVT)="" Q 0
;
;Get VIEN from context
S VIEN=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
;
;Look for invalid visit
I VIEN="" Q 0
S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VIEN=+$$VSTR2VIS^BEHOENCX(DFN,VIEN) I VIEN<1 Q 0
;
Q VIEN
GETER(DFN,ADMF,VSTF) ;Return information from either ER VISIT or ER ADMISSION files
;
N RET,AIEN,FNDER,VIEN
;
I $G(DFN)="" Q ""
;
;Get the visit
S VIEN=$$GVISIT(DFN) Q:'VIEN "-1^Visit not selected/found"
;
;Look in ER VISIT file
S (FNDER,RET)=""
S AIEN=$O(^AMERVSIT("AD",VIEN,""))
I AIEN S FNDER=1,RET=$$GET1^DIQ(9009080,AIEN,VSTF,"E")
;
;If not found look in ER ADMISSION file (VIEN must match)
I FNDER="",(VIEN'=$$GET1^DIQ(9009081,DFN,1.1,"I"))!('$D(^AMERADM(DFN))) Q "-1^Could not locate ER visit"
I RET="" S RET=$$GET1^DIQ(9009081,DFN,ADMF,"E")
Q RET
ERADMIT(DFN,CAP) ;ER ADMIT TIME and ER ADMIT TIME W/CAPTION - Return ER admission time
N RET,IEN
S CAP=$G(CAP)
S RET=$$GETER(DFN,1,.01) I $P(RET,U)=-1 Q $P(RET,U,2)
I CAP=1 S RET="Arrival Time: "_RET
Q RET
;
WHY(DFN,CAP) ;ER COMPLAINT and ER COMPLAINT W/CAPTION - Return the presenting complaint
N RET
S CAP=$G(CAP)
S RET=$$GETER(DFN,23,1) I $P(RET,U)=-1 Q $P(RET,U,2)
I CAP=1 S RET="Presenting Complaint: "_RET
Q RET
NURSE(DFN,CAP) ;ER TRIAGE NURSE and ER TRIAGE NURSE W/CAPTION - Return the Triage Nurse
N RET
S CAP=$G(CAP)
S RET=$$GETER(DFN,19,.07) I $P(RET,U)=-1 Q $P(RET,U,2)
I CAP=1 S RET="Triage Nurse: "_RET
Q RET
ACUITY(DFN,CAP) ;ER INITIAL ACUITY and ER INITIAL ACUITY W/CAPTION - Return the Initial Acuity
N RET,IEN
S CAP=$G(CAP)
S RET=$$GETER(DFN,20,.24) I $P(RET,U)=-1 Q $P(RET,U,2)
I CAP=1 S RET="Initial Acuity: "_RET
Q RET
NTIME(DFN,CAP) ;ER TRIAGE NURSE TIME and ER TRIAGE NURSE TIME W/CAPTION - Return the Triage Nurse Time
N RET,IEN
S CAP=$G(CAP)
S RET=$$GETER(DFN,21,12.2) I $P(RET,U)=-1 Q $P(RET,U,2)
I CAP=1 S RET="Triage Nurse Time: "_RET
Q RET
ADMIT(DFN,CAP) ;ER ADMIT PROVIDER and ER ADMIT PROV W/CAPTION - Return the Admitting Provider
N RET,IEN
S CAP=$G(CAP)
S RET=$$GETER(DFN,18,.06) I $P(RET,U)=-1 Q $P(RET,U,2)
I CAP=1 S RET="Provider: "_RET
Q RET
ATIME(DFN,CAP) ;ER ADMIT PROV TIME and ER ADMIT PROV TIME/CAPTION - Return the Admitting Provider Time
N RET,IEN
S CAP=$G(CAP)
S RET=$$GETER(DFN,22,12.1) I $P(RET,U)=-1 Q $P(RET,U,2)
I CAP=1 S RET="Provider Time: "_RET
Q RET
BTIUPCC7 ; IHS/MSC/MGH - IHS PCC PERSONAL HEALTH OBJECTS ;28-Jun-2017 14:15;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1008,1009,1013,1018**;NOV 04, 2004;Build 4
+2 ;This routine creates objects for the personal health
+3 ;data entered
+4 ;Patch 1018 added ER admission objects
+5 ;==============================================================
CVD(DFN,TARGET) ;EP
+1 NEW ARRAY,CNT,I,J
+2 SET CNT=1
+3 DO PAT^BQITRPHS(DFN,.ARRAY)
+4 IF $PIECE(ARRAY(0),U,1)=1
SET @TARGET@(CNT,0)=$PIECE(ARRAY(0),U,2)
+5 IF '$TEST
SET @TARGET@(CNT,0)="Patient does not have an iCare Diagnostic Tag of CVD"
+6 SET I=0
FOR
SET I=$ORDER(ARRAY(I))
IF I=""
QUIT
Begin DoDot:1
+7 SET CNT=CNT+1
SET @TARGET@(CNT,0)=""
+8 SET J=0
FOR
SET J=$ORDER(ARRAY(I,J))
IF J=""
QUIT
Begin DoDot:2
+9 SET CNT=CNT+1
+10 SET @TARGET@(CNT,0)=$GET(ARRAY(I,J,0))
End DoDot:2
End DoDot:1
+11 QUIT "~@"_$NAME(@TARGET)
LABRES(DFN,TIUTST,TIUCNT) ;EP; -- returns last # of current lab result for single
+1 ; TIUTST = lab test name; TIUCNT = # of test results to return
+2 ;IHS/CIA/MGH Modified to only display the test name and results
+3 NEW LAB,CAPTION,VDT,DATE,IEN,X,TIU,LINE,CNT,DATA,LGTH,DATE,Y,ARR
+4 KILL ^TMP("BTIULOX",$JOB)
+5 SET LAB=$ORDER(^LAB(60,"B",TIUTST,0))
IF LAB=""
QUIT ""
+6 SET CAPTION=$EXTRACT(TIUTST,1,30)_":"
+7 SET (VDT,CNT)=0
SET ARR=""
+8 FOR
SET VDT=$ORDER(^AUPNVLAB("AA",DFN,LAB,VDT))
IF ('VDT)!(CNT=TIUCNT)
QUIT
Begin DoDot:1
+9 SET IEN=0
+10 FOR
SET IEN=$ORDER(^AUPNVLAB("AA",DFN,LAB,VDT,IEN))
IF 'IEN!(CNT=TIUCNT)
QUIT
Begin DoDot:2
+11 KILL TIU
DO ENP^XBDIQ1(9000010.09,IEN,".03:.05;1109;1201","TIU(","I")
+12 ;skip if not resulted
IF TIU(.04)=""
QUIT
+13 ;increment counter
SET CNT=CNT+1
+14 SET DATE=$SELECT(TIU(1201,"I")]"":TIU(1201,"I"),1:$$GET1^DIQ(9000010,TIU(.03,"I"),.01,"I"))
+15 SET ARR(DATE,IEN)=$JUSTIFY(TIU(.04),8)_" "_TIU(.05)
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+16 SET CNT=0
SET DATE=""
+17 FOR
SET DATE=$ORDER(ARR(DATE),-1)
IF DATE=""!(CNT>=TIUCNT)
QUIT
Begin DoDot:1
+18 SET IEN=""
FOR
SET IEN=$ORDER(ARR(DATE,IEN),-1)
IF 'IEN!(CNT>=TIUCNT)
QUIT
Begin DoDot:2
+19 SET LINE=$GET(ARR(DATE,IEN))
SET CNT=CNT+1
+20 SET Y=$SELECT(CNT=1:CAPTION,1:$$SP($LENGTH(CAPTION)))
+21 SET ^TMP("BTIULOX",$JOB,CNT,0)=Y_LINE
End DoDot:2
End DoDot:1
+22 IF '$DATA(^TMP("BTIULOX",$JOB))
SET ^TMP("BTIULOX",$JOB,1,0)="No Results Found"
+23 QUIT "~@^TMP(""BTIULOX"",$J)"
SP(NUM) ; -- SUBRTN to pad spaces
+1 QUIT $$PAD(" ",NUM)
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
+1 QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
PHISTORY(DFN,TARGET) ;Return personal history data
+1 NEW DATA,BTIU,IEN,FNUM,CNT,RESULT,DATE,LINE,NUM,ONSET,ENTRY
+2 SET FNUM=9000013
SET CNT=0
SET ENTRY=""
SET ONSET=""
+3 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNPH("AC",DFN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+4 SET CNT=$GET(CNT)+1
SET NUM=$GET(NUM)+1
+5 KILL BTIU
DO ENP^XBDIQ1(9000013,IEN,".01;.02:.07;","BTIU(","I")
+6 SET LINE=$JUSTIFY(NUM,2)_") "_$GET(BTIU(.04))_" Noted: "_$GET(BTIU(.03))
+7 IF $GET(BTIU(.05))'=""
SET LINE=LINE_" Onset: "_$GET(BTIU(.05))
+8 SET @TARGET@(CNT,0)=LINE
End DoDot:1
+9 IF CNT=0
SET @TARGET@(1,0)="No personal history on file"
+10 QUIT "~@"_$NAME(@TARGET)
GVISIT(DFN) ;Retrieve VIEN
+1 ;
+2 NEW X,VIEN
+3 ;
+4 ;Check for CIA
+5 IF $TEXT(GETVAR^CIAVMEVT)=""
QUIT 0
+6 ;
+7 ;Get VIEN from context
+8 SET VIEN=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+9 ;
+10 ;Look for invalid visit
+11 IF VIEN=""
QUIT 0
+12 SET X="BEHOENCX"
XECUTE ^%ZOSF("TEST")
IF $TEST
SET VIEN=+$$VSTR2VIS^BEHOENCX(DFN,VIEN)
IF VIEN<1
QUIT 0
+13 ;
+14 QUIT VIEN
GETER(DFN,ADMF,VSTF) ;Return information from either ER VISIT or ER ADMISSION files
+1 ;
+2 NEW RET,AIEN,FNDER,VIEN
+3 ;
+4 IF $GET(DFN)=""
QUIT ""
+5 ;
+6 ;Get the visit
+7 SET VIEN=$$GVISIT(DFN)
IF 'VIEN
QUIT "-1^Visit not selected/found"
+8 ;
+9 ;Look in ER VISIT file
+10 SET (FNDER,RET)=""
+11 SET AIEN=$ORDER(^AMERVSIT("AD",VIEN,""))
+12 IF AIEN
SET FNDER=1
SET RET=$$GET1^DIQ(9009080,AIEN,VSTF,"E")
+13 ;
+14 ;If not found look in ER ADMISSION file (VIEN must match)
+15 IF FNDER=""
IF (VIEN'=$$GET1^DIQ(9009081,DFN,1.1,"I"))!('$DATA(^AMERADM(DFN)))
QUIT "-1^Could not locate ER visit"
+16 IF RET=""
SET RET=$$GET1^DIQ(9009081,DFN,ADMF,"E")
+17 QUIT RET
ERADMIT(DFN,CAP) ;ER ADMIT TIME and ER ADMIT TIME W/CAPTION - Return ER admission time
+1 NEW RET,IEN
+2 SET CAP=$GET(CAP)
+3 SET RET=$$GETER(DFN,1,.01)
IF $PIECE(RET,U)=-1
QUIT $PIECE(RET,U,2)
+4 IF CAP=1
SET RET="Arrival Time: "_RET
+5 QUIT RET
+6 ;
WHY(DFN,CAP) ;ER COMPLAINT and ER COMPLAINT W/CAPTION - Return the presenting complaint
+1 NEW RET
+2 SET CAP=$GET(CAP)
+3 SET RET=$$GETER(DFN,23,1)
IF $PIECE(RET,U)=-1
QUIT $PIECE(RET,U,2)
+4 IF CAP=1
SET RET="Presenting Complaint: "_RET
+5 QUIT RET
NURSE(DFN,CAP) ;ER TRIAGE NURSE and ER TRIAGE NURSE W/CAPTION - Return the Triage Nurse
+1 NEW RET
+2 SET CAP=$GET(CAP)
+3 SET RET=$$GETER(DFN,19,.07)
IF $PIECE(RET,U)=-1
QUIT $PIECE(RET,U,2)
+4 IF CAP=1
SET RET="Triage Nurse: "_RET
+5 QUIT RET
ACUITY(DFN,CAP) ;ER INITIAL ACUITY and ER INITIAL ACUITY W/CAPTION - Return the Initial Acuity
+1 NEW RET,IEN
+2 SET CAP=$GET(CAP)
+3 SET RET=$$GETER(DFN,20,.24)
IF $PIECE(RET,U)=-1
QUIT $PIECE(RET,U,2)
+4 IF CAP=1
SET RET="Initial Acuity: "_RET
+5 QUIT RET
NTIME(DFN,CAP) ;ER TRIAGE NURSE TIME and ER TRIAGE NURSE TIME W/CAPTION - Return the Triage Nurse Time
+1 NEW RET,IEN
+2 SET CAP=$GET(CAP)
+3 SET RET=$$GETER(DFN,21,12.2)
IF $PIECE(RET,U)=-1
QUIT $PIECE(RET,U,2)
+4 IF CAP=1
SET RET="Triage Nurse Time: "_RET
+5 QUIT RET
ADMIT(DFN,CAP) ;ER ADMIT PROVIDER and ER ADMIT PROV W/CAPTION - Return the Admitting Provider
+1 NEW RET,IEN
+2 SET CAP=$GET(CAP)
+3 SET RET=$$GETER(DFN,18,.06)
IF $PIECE(RET,U)=-1
QUIT $PIECE(RET,U,2)
+4 IF CAP=1
SET RET="Provider: "_RET
+5 QUIT RET
ATIME(DFN,CAP) ;ER ADMIT PROV TIME and ER ADMIT PROV TIME/CAPTION - Return the Admitting Provider Time
+1 NEW RET,IEN
+2 SET CAP=$GET(CAP)
+3 SET RET=$$GETER(DFN,22,12.1)
IF $PIECE(RET,U)=-1
QUIT $PIECE(RET,U,2)
+4 IF CAP=1
SET RET="Provider Time: "_RET
+5 QUIT RET
