- 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
