BTIULO7A ;IHS/ITSC/LJF - IHS OBJECTS ADDED IN PATCHES;22-Apr-2015 17:07;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1012,1013**;NOV 04, 2004;Build 33
OLD(DFN,TARGET,MODE) ;Old objects
S X=$$GET1^DIQ(9000017,+$G(DFN),1)
I X]"" D
.S GRAV=$P(X,"P",1),OTHER=$P(X,"P",2)
.S PARA=$P(OTHER,"LC",1),OTHER=$P(OTHER,"LC",2)
.S LC=$P(OTHER,"SA",1),OTHER=$P(OTHER,"SA",2)
.S SA=$P(OTHER,"TA",1),OTHER=$P(OTHER,"TA",2)
.S TA=OTHER
.S X=GRAV_" P"_PARA_" LC"_LC_" SA"_SA_" TA"_TA
I (MODE="B")!(X="") Q "R HX: "_$S(X="":"None Recorded",1:X)
S @TARGET@(1,0)="R HX: "_X_" (recorded on "_$$GET1^DIQ(9000017,+$G(DFN),1.1)_")"
Q "~@"_$NA(@TARGET)
;
FPM(DFN,TARGET,MODE) ;EP; CONTRACEPTION-BRIEF object
;MODE="B" or "E"
NEW X,FPBEGIN,FPDATE,BHX,TYP,START,END,CNT,LINE,LIN1,BHC
K @TARGET
S CNT=0
I $P(^DPT(DFN,0),U,2)="M" Q "Patient is male"
S BHX=0 F S BHX=$O(^AUPNREP(DFN,2101,BHX)) Q:BHX'=+BHX D
.Q:$D(^AUPNREP(DFN,2101,BHX,1))>0
.S BHC=$P(^AUPNREP(DFN,2101,BHX,0),U,1) I BHC D
..S TYP=$P(^AUTTCM(BHC,0),U)
..S START=$P(^AUPNREP(DFN,2101,BHX,0),U,2) I START]"" S START=$$FIXDT^BHSFAM1(START)
..S END=$P(^AUPNREP(DFN,2101,BHX,0),U,3) I END]"" S END=$$FIXDT^BHSFAM1(END)
..I CNT=0 D
...S CNT=CNT+1 S @TARGET@(CNT,0)=""
...S CNT=CNT+1 S @TARGET@(CNT,0)="FP METHOD: "
..S LINE=$S(TYP="":"None Recorded",1:TYP)
..I MODE="B"&(END="") D
...S CNT=CNT+1
...S LINE=" "_LINE_" Start Dt: "_START
...S @TARGET@(CNT,0)=LINE
..I MODE="E" D
...S CNT=CNT+1
...S LINE=" "_LINE_" Start Dt: "_START
...S @TARGET@(CNT,0)=LINE
...I END'="" D
....S CNT=CNT+1
....S LIN1=""
....I $P(^AUPNREP(DFN,2101,BHX,0),U,5)]"" S LIN1=" Reason Discontinued: "_$P(^AUPNREP(DFN,2101,BHX,0),U,5)
....S @TARGET@(CNT,0)=" End Dt: "_END_LIN1
Q "~@"_$NA(@TARGET)
;
TODAYVIT(PAT) ;EP; returns all vitals taken today
NEW MEAS,VST,VDT,END,APCLV,ERR,TYPE,VALUE,VDATE
;
; for each visit patient had today, find all measurements taken
S VDT=9999999-DT,END=VDT_".2359"
F S VDT=$O(^AUPNVSIT("AA",PAT,VDT)) Q:'VDT!(VDT>END) D
. S VST=$O(^AUPNVSIT("AA",PAT,VDT,0)) Q:'VST
. S ERR=$$PCCVF^APCLV(VST,"MEASUREMENT","7;8") I ERR Q
. S X=0 F S X=$O(APCLV(X)) Q:'X D
. . S MEAS($P(APCLV(X),U),VDT)=$P(APCLV(X),U,2)
;
; loop through all measurements found for patient and date; pick most recent ones
S RESULT=""
S TYPE=0 F S TYPE=$O(MEAS(TYPE)) Q:TYPE="" D
. S VDATE=$O(MEAS(TYPE,""),-1) ;get latest date/time
. S VALUE=MEAS(TYPE,VDATE) ;get value for this measurement & date/time
. I TYPE="WT" S VALUE=$J(VALUE,5,2)_" ("_$J((VALUE*.454),5,2)_" kg)"
. I ((TYPE="HT")!(TYPE="HC")!(TYPE="WC")!(TYPE="AG")) S VALUE=$J(VALUE,5,2)_" ("_$J((VALUE*2.54),5,2)_" cm)"
. I TYPE="TMP" S VALUE=VALUE_" ("_(((10*((VALUE-32)/1.8))\1)/10)_" C)"
. I TYPE="BMI" D
. .S VALUE=$J(VALUE,5,2)
. .I $$PNM^APCLSIL1(DFN,DT)="Y" S VALUE=VALUE_"*"
. S RESULT=RESULT_TYPE_":"_VALUE_", "
S RESULT=$E(RESULT,1,$L(RESULT)-2) ;remove last comma
Q RESULT
;
TODAYLAB(PAT) ;EP; returns all labs taken today;PATCH 1002 new code
NEW VDT,END,VISIT,COUNT,TIUX,LINE,TIUA
K ^TMP("BTIULO",$J)
;
; for each visit patient had today, find all labs
S VDT=9999999-DT,END=VDT_".2359"
F S VDT=$O(^AUPNVSIT("AA",PAT,VDT)) Q:'VDT Q:VDT>END D
. S VISIT=0 F S VISIT=$O(^AUPNVSIT("AA",PAT,VDT,VISIT)) Q:'VISIT D
. . S TIUX=0,LINE="" F S TIUX=$O(^AUPNVLAB("AD",VISIT,TIUX)) Q:'TIUX D
. . . K TIUA D ENP^XBDIQ1(9000010.09,TIUX,".01;.04;.05;1109","TIUA(")
. . . I TIUA(.04)="",TIUA(1109)="RESULTED" Q
. . . S LINE=" "_$$PAD^BTIULO7(TIUA(.01),25)_" " ;lab test
. . . S LINE=LINE_$$PAD^BTIULO7(TIUA(.04),10)_TIUA(.05) ;result
. . . I TIUA(.04)="" S LINE=LINE_TIUA(1109)
. . . S COUNT=$G(COUNT)+1 S ^TMP("BTIULO",$J,COUNT,0)=LINE
;
I '$D(^TMP("BTIULO",$J)) Q "No Labs Found for Today"
Q "~@^TMP(""BTIULO"",$J)"
;
TODAYMED(PAT,SIG) ;EP; returns all meds dispensed today;PATCH 1002 new code
; If SIG=1 include sig
NEW VDT,END,VISIT,COUNT,RESULT,I
K ^TMP("BTIULO",$J)
;
; for each visit patient had today, find all meds
S VDT=9999999-DT,END=VDT_".2359"
F S VDT=$O(^AUPNVSIT("AA",PAT,VDT)) Q:'VDT Q:VDT>END D
. S VISIT=0 F S VISIT=$O(^AUPNVSIT("AA",PAT,VDT,VISIT)) Q:'VISIT D
. . K RESULT
. . I $G(SIG) D GETSIG^BTIULO5(.RESULT,VISIT) I 1
. . E D GETMED^BTIULO5(.RESULT,VISIT)
. . ;
. . S I=0 F S I=$O(RESULT(I)) Q:'I D
. . . S COUNT=$G(COUNT)+1
. . . S ^TMP("BTIULO",$J,COUNT,0)=RESULT(I)
;
I '$D(^TMP("BTIULO",$J)) Q "No Medications Found for Today"
Q "~@^TMP(""BTIULO"",$J)"
;
QUAL(MEAS) ; Get qualifiers for a measurement
N QUALS,QUALN,QUALIF,TYPE,TNAME,O2
S (QUALIF,O2)=""
S TYPE=$P($G(^AUPNVMSR(MEAS,0)),U,1)
S TNAME=$P($G(^AUTTMSR(TYPE,0)),U,1)
S QUALS=0 F S QUALS=$O(^AUPNVMSR(MEAS,5,QUALS)) Q:QUALS="" D
.S QUALN=$P($G(^AUPNVMSR(MEAS,5,QUALS,0)),U,1)
.I +QUALN S QUALN=$P($G(^GMRD(120.52,QUALN,0)),U,1)
.I QUALIF="" S QUALIF=QUALN
.E I QUALN'="" S QUALIF=QUALIF_","_QUALN
I TNAME="O2" D
.S O2=$P($G(^AUPNVMSR(MEAS,0)),U,10)
.S QUALIF=QUALIF_" "_O2
Q QUALIF
BTIULO7A ;IHS/ITSC/LJF - IHS OBJECTS ADDED IN PATCHES;22-Apr-2015 17:07;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1012,1013**;NOV 04, 2004;Build 33
OLD(DFN,TARGET,MODE) ;Old objects
+1 SET X=$$GET1^DIQ(9000017,+$GET(DFN),1)
+2 IF X]""
Begin DoDot:1
+3 SET GRAV=$PIECE(X,"P",1)
SET OTHER=$PIECE(X,"P",2)
+4 SET PARA=$PIECE(OTHER,"LC",1)
SET OTHER=$PIECE(OTHER,"LC",2)
+5 SET LC=$PIECE(OTHER,"SA",1)
SET OTHER=$PIECE(OTHER,"SA",2)
+6 SET SA=$PIECE(OTHER,"TA",1)
SET OTHER=$PIECE(OTHER,"TA",2)
+7 SET TA=OTHER
+8 SET X=GRAV_" P"_PARA_" LC"_LC_" SA"_SA_" TA"_TA
End DoDot:1
+9 IF (MODE="B")!(X="")
QUIT "R HX: "_$SELECT(X="":"None Recorded",1:X)
+10 SET @TARGET@(1,0)="R HX: "_X_" (recorded on "_$$GET1^DIQ(9000017,+$GET(DFN),1.1)_")"
+11 QUIT "~@"_$NAME(@TARGET)
+12 ;
FPM(DFN,TARGET,MODE) ;EP; CONTRACEPTION-BRIEF object
+1 ;MODE="B" or "E"
+2 NEW X,FPBEGIN,FPDATE,BHX,TYP,START,END,CNT,LINE,LIN1,BHC
+3 KILL @TARGET
+4 SET CNT=0
+5 IF $PIECE(^DPT(DFN,0),U,2)="M"
QUIT "Patient is male"
+6 SET BHX=0
FOR
SET BHX=$ORDER(^AUPNREP(DFN,2101,BHX))
IF BHX'=+BHX
QUIT
Begin DoDot:1
+7 IF $DATA(^AUPNREP(DFN,2101,BHX,1))>0
QUIT
+8 SET BHC=$PIECE(^AUPNREP(DFN,2101,BHX,0),U,1)
IF BHC
Begin DoDot:2
+9 SET TYP=$PIECE(^AUTTCM(BHC,0),U)
+10 SET START=$PIECE(^AUPNREP(DFN,2101,BHX,0),U,2)
IF START]""
SET START=$$FIXDT^BHSFAM1(START)
+11 SET END=$PIECE(^AUPNREP(DFN,2101,BHX,0),U,3)
IF END]""
SET END=$$FIXDT^BHSFAM1(END)
+12 IF CNT=0
Begin DoDot:3
+13 SET CNT=CNT+1
SET @TARGET@(CNT,0)=""
+14 SET CNT=CNT+1
SET @TARGET@(CNT,0)="FP METHOD: "
End DoDot:3
+15 SET LINE=$SELECT(TYP="":"None Recorded",1:TYP)
+16 IF MODE="B"&(END="")
Begin DoDot:3
+17 SET CNT=CNT+1
+18 SET LINE=" "_LINE_" Start Dt: "_START
+19 SET @TARGET@(CNT,0)=LINE
End DoDot:3
+20 IF MODE="E"
Begin DoDot:3
+21 SET CNT=CNT+1
+22 SET LINE=" "_LINE_" Start Dt: "_START
+23 SET @TARGET@(CNT,0)=LINE
+24 IF END'=""
Begin DoDot:4
+25 SET CNT=CNT+1
+26 SET LIN1=""
+27 IF $PIECE(^AUPNREP(DFN,2101,BHX,0),U,5)]""
SET LIN1=" Reason Discontinued: "_$PIECE(^AUPNREP(DFN,2101,BHX,0),U,5)
+28 SET @TARGET@(CNT,0)=" End Dt: "_END_LIN1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+29 QUIT "~@"_$NAME(@TARGET)
+30 ;
TODAYVIT(PAT) ;EP; returns all vitals taken today
+1 NEW MEAS,VST,VDT,END,APCLV,ERR,TYPE,VALUE,VDATE
+2 ;
+3 ; for each visit patient had today, find all measurements taken
+4 SET VDT=9999999-DT
SET END=VDT_".2359"
+5 FOR
SET VDT=$ORDER(^AUPNVSIT("AA",PAT,VDT))
IF 'VDT!(VDT>END)
QUIT
Begin DoDot:1
+6 SET VST=$ORDER(^AUPNVSIT("AA",PAT,VDT,0))
IF 'VST
QUIT
+7 SET ERR=$$PCCVF^APCLV(VST,"MEASUREMENT","7;8")
IF ERR
QUIT
+8 SET X=0
FOR
SET X=$ORDER(APCLV(X))
IF 'X
QUIT
Begin DoDot:2
+9 SET MEAS($PIECE(APCLV(X),U),VDT)=$PIECE(APCLV(X),U,2)
End DoDot:2
End DoDot:1
+10 ;
+11 ; loop through all measurements found for patient and date; pick most recent ones
+12 SET RESULT=""
+13 SET TYPE=0
FOR
SET TYPE=$ORDER(MEAS(TYPE))
IF TYPE=""
QUIT
Begin DoDot:1
+14 ;get latest date/time
SET VDATE=$ORDER(MEAS(TYPE,""),-1)
+15 ;get value for this measurement & date/time
SET VALUE=MEAS(TYPE,VDATE)
+16 IF TYPE="WT"
SET VALUE=$JUSTIFY(VALUE,5,2)_" ("_$JUSTIFY((VALUE*.454),5,2)_" kg)"
+17 IF ((TYPE="HT")!(TYPE="HC")!(TYPE="WC")!(TYPE="AG"))
SET VALUE=$JUSTIFY(VALUE,5,2)_" ("_$JUSTIFY((VALUE*2.54),5,2)_" cm)"
+18 IF TYPE="TMP"
SET VALUE=VALUE_" ("_(((10*((VALUE-32)/1.8))\1)/10)_" C)"
+19 IF TYPE="BMI"
Begin DoDot:2
+20 SET VALUE=$JUSTIFY(VALUE,5,2)
+21 IF $$PNM^APCLSIL1(DFN,DT)="Y"
SET VALUE=VALUE_"*"
End DoDot:2
+22 SET RESULT=RESULT_TYPE_":"_VALUE_", "
End DoDot:1
+23 ;remove last comma
SET RESULT=$EXTRACT(RESULT,1,$LENGTH(RESULT)-2)
+24 QUIT RESULT
+25 ;
TODAYLAB(PAT) ;EP; returns all labs taken today;PATCH 1002 new code
+1 NEW VDT,END,VISIT,COUNT,TIUX,LINE,TIUA
+2 KILL ^TMP("BTIULO",$JOB)
+3 ;
+4 ; for each visit patient had today, find all labs
+5 SET VDT=9999999-DT
SET END=VDT_".2359"
+6 FOR
SET VDT=$ORDER(^AUPNVSIT("AA",PAT,VDT))
IF 'VDT
QUIT
IF VDT>END
QUIT
Begin DoDot:1
+7 SET VISIT=0
FOR
SET VISIT=$ORDER(^AUPNVSIT("AA",PAT,VDT,VISIT))
IF 'VISIT
QUIT
Begin DoDot:2
+8 SET TIUX=0
SET LINE=""
FOR
SET TIUX=$ORDER(^AUPNVLAB("AD",VISIT,TIUX))
IF 'TIUX
QUIT
Begin DoDot:3
+9 KILL TIUA
DO ENP^XBDIQ1(9000010.09,TIUX,".01;.04;.05;1109","TIUA(")
+10 IF TIUA(.04)=""
IF TIUA(1109)="RESULTED"
QUIT
+11 ;lab test
SET LINE=" "_$$PAD^BTIULO7(TIUA(.01),25)_" "
+12 ;result
SET LINE=LINE_$$PAD^BTIULO7(TIUA(.04),10)_TIUA(.05)
+13 IF TIUA(.04)=""
SET LINE=LINE_TIUA(1109)
+14 SET COUNT=$GET(COUNT)+1
SET ^TMP("BTIULO",$JOB,COUNT,0)=LINE
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;
+16 IF '$DATA(^TMP("BTIULO",$JOB))
QUIT "No Labs Found for Today"
+17 QUIT "~@^TMP(""BTIULO"",$J)"
+18 ;
TODAYMED(PAT,SIG) ;EP; returns all meds dispensed today;PATCH 1002 new code
+1 ; If SIG=1 include sig
+2 NEW VDT,END,VISIT,COUNT,RESULT,I
+3 KILL ^TMP("BTIULO",$JOB)
+4 ;
+5 ; for each visit patient had today, find all meds
+6 SET VDT=9999999-DT
SET END=VDT_".2359"
+7 FOR
SET VDT=$ORDER(^AUPNVSIT("AA",PAT,VDT))
IF 'VDT
QUIT
IF VDT>END
QUIT
Begin DoDot:1
+8 SET VISIT=0
FOR
SET VISIT=$ORDER(^AUPNVSIT("AA",PAT,VDT,VISIT))
IF 'VISIT
QUIT
Begin DoDot:2
+9 KILL RESULT
+10 IF $GET(SIG)
DO GETSIG^BTIULO5(.RESULT,VISIT)
IF 1
+11 IF '$TEST
DO GETMED^BTIULO5(.RESULT,VISIT)
+12 ;
+13 SET I=0
FOR
SET I=$ORDER(RESULT(I))
IF 'I
QUIT
Begin DoDot:3
+14 SET COUNT=$GET(COUNT)+1
+15 SET ^TMP("BTIULO",$JOB,COUNT,0)=RESULT(I)
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
+17 IF '$DATA(^TMP("BTIULO",$JOB))
QUIT "No Medications Found for Today"
+18 QUIT "~@^TMP(""BTIULO"",$J)"
+19 ;
QUAL(MEAS) ; Get qualifiers for a measurement
+1 NEW QUALS,QUALN,QUALIF,TYPE,TNAME,O2
+2 SET (QUALIF,O2)=""
+3 SET TYPE=$PIECE($GET(^AUPNVMSR(MEAS,0)),U,1)
+4 SET TNAME=$PIECE($GET(^AUTTMSR(TYPE,0)),U,1)
+5 SET QUALS=0
FOR
SET QUALS=$ORDER(^AUPNVMSR(MEAS,5,QUALS))
IF QUALS=""
QUIT
Begin DoDot:1
+6 SET QUALN=$PIECE($GET(^AUPNVMSR(MEAS,5,QUALS,0)),U,1)
+7 IF +QUALN
SET QUALN=$PIECE($GET(^GMRD(120.52,QUALN,0)),U,1)
+8 IF QUALIF=""
SET QUALIF=QUALN
+9 IF '$TEST
IF QUALN'=""
SET QUALIF=QUALIF_","_QUALN
End DoDot:1
+10 IF TNAME="O2"
Begin DoDot:1
+11 SET O2=$PIECE($GET(^AUPNVMSR(MEAS,0)),U,10)
+12 SET QUALIF=QUALIF_" "_O2
End DoDot:1
+13 QUIT QUALIF
