BQIUTB6 ;GDIT/HCSD/ALA-Table Utility ; 13 Jul 2015 8:00 AM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
;
TIME(DATA,PARM) ;EP - BQI GET TIMEFRAMES
NEW UID,II,X
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP(UID,"BQITABLE"))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
S PARM=$G(PARM,"") I PARM="" Q
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIUTB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
NEW LN,BZ,ORD,VAL
K BZ
S II=0,LN=""
S @DATA@(II)="T00010CODE^T00060DESC"_$C(30)
S ORD=""
F S ORD=$O(^BQI(90506.9,"D",PARM,ORD)) Q:ORD="" D
. S LN=$O(^BQI(90506.9,"D",PARM,ORD,""))
. I LN'="" S VAL=$P(^BQI(90506.9,LN,0),U,3)
. I $E(PARM,1,3)="IPM"!($E(PARM,1,3)="IPW") S VAL=""
. S II=II+1,@DATA@(II)=VAL_"^"_$P(^BQI(90506.9,LN,0),U,1)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
MEAS(DATA) ;EP - Measurements
NEW RN,COD,TYPE,VALUE
S II=0,RN=0
S @DATA@(II)="I00010IEN^T00030^T00010TYPE^T00030VALUE^T00003PARENT_IEN"_$C(30)
F S RN=$O(^BQI(90507.2,RN)) Q:'RN D
. S MN=$P(^BQI(90507.2,RN,0),"^",3)
. I $G(^AUTTMSR(MN,0))="" Q
. I $P(^AUTTMSR(MN,0),U,4)=1 Q
. ;I $P(^BQI(90507.2,RN,0),"^",1)="BLOOD PRESSURE"!($P(^BQI(90507.2,RN,0),"^",1)="ANKLE BLOOD PRESSURE") Q
. ;I $P(^BQI(90507.2,RN,0),"^",5)'="" Q
. S TYPE=$$GET1^DIQ(90507.2,RN_",",.04,"E"),VALUE=""
. S COD=$P(^BQI(90507.2,RN,0),"^",2),DESC=$P(^(0),"^",1)
. I TYPE["SET" S VALUE=$G(^BQI(90507.2,RN,2))
. S II=II+1,@DATA@(II)=RN_U_DESC_" ("_$E(TYPE,1,1)_")"_U_TYPE_U_VALUE_U_$P(^BQI(90507.2,RN,0),"^",5)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
MEASD(DATA,MIEN) ;EP - BQI GET MEASUREMENT DETAIL
NEW UID,II,X,RN,MAX,MIN,HDR,COD,TYPE,VALUE,NDEC,TOOL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP(UID,"BQIMEASD"))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIUTB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S II=0
S HDR="T00010IEN^T00030DESC^T00010TYPE^T00030VALUE^I00010NBOX^I00010B1MIN^I00010B1MAX^"
S HDR=HDR_"I00010B2MIN^I00010B2MAX^I00010NDEC^T00070TOOLTIP"
S @DATA@(II)=HDR_$C(30)
S MIEN=$G(MIEN,"")
I MIEN="" D
. S RN=0
. F S RN=$O(^BQI(90507.2,RN)) Q:'RN D
.. S MN=$P(^BQI(90507.2,RN,0),"^",3),COD=$P(^(0),U,2)
.. I $G(^AUTTMSR(MN,0))="" Q
.. I $P(^AUTTMSR(MN,0),U,4)=1 Q
.. ;I $P(^BQI(90507.2,RN,0),"^",1)["BLOOD PRESSURE" Q
.. I $P(^BQI(90507.2,RN,0),"^",5)'="" Q
.. S TOOL=$P($G(^BQI(90507.2,RN,3)),"^",1)
.. D MD(RN)
.. S II=II+1,@DATA@(II)=RN_U_COD_U_TYPE_U_VALUE_U_NBOX_U_BOX1MIN_U_BOX1MAX_U_BOX2MIN_U_BOX2MAX_U_NDEC_U_TOOL_$C(30)
.. I $D(SUB) S N="" F S N=$O(SUB(N)) Q:N="" S II=II+1,@DATA@(II)=SUB(N)
.. K SUB
;
I MIEN'="" D
. S COD=$P(^BQI(90507.2,MIEN,0),"^",2)
. D MD(MIEN)
. S TOOL=$P($G(^BQI(90507.2,MIEN,3)),"^",1)
. S II=II+1,@DATA@(II)=MIEN_U_COD_U_TYPE_U_VALUE_U_NBOX_U_BOX1MIN_U_BOX1MAX_U_BOX2MIN_U_BOX2MAX_U_NDEC_U_TOOL_$C(30)
. I $D(SUB) S N="" F S N=$O(SUB(N)) Q:N="" S II=II+1,@DATA@(II)=SUB(N)
. K SUB
;
S II=II+1,@DATA@(II)=$C(31)
K TYPE,VALUE,NBOX,BOX1MIN,BOX1MAX,BOX2MIN,BOX2MAX,NDEC
Q
;
MD(RN) ;EP
NEW MDATA,MN,CT
S (TYPE,VALUE,NBOX,BOX1MIN,BOX2MIN,BOX1MAX,BOX2MAX,NDEC)=""
S TYPE=$$GET1^DIQ(90507.2,RN_",",.04,"E")
I TYPE["SET" S VALUE=$G(^BQI(90507.2,RN,2))
S MDATA=$G(^BQI(90507.2,RN,1))
S TOOL=$P($G(^BQI(90507.2,RN,3)),"^",1)
S NBOX=$P(MDATA,"^",1),NDEC=$P(MDATA,"^",18)
I NBOX=1 S BOX1MIN=$P(MDATA,"^",2),BOX1MAX=$P(MDATA,"^",3)
I NBOX=2 S BOX1MIN=$P(MDATA,"^",2),BOX1MAX=$P(MDATA,"^",3),BOX2MIN=$P(MDATA,"^",4),BOX2MAX=$P(MDATA,"^",5)
S MN="",CT=0 F S MN=$O(^BQI(90507.2,"AD",RN,MN)) Q:MN="" D
. S CT=CT+1,SUB(CT)=MN_U_$P(^BQI(90507.2,MN,0),"^",2)_U_$$GET1^DIQ(90507.2,MN_",",.04,"E")_U_$G(^BQI(90507.2,MN,2))_"^^^^^^"_U_TOOL_$C(30)
Q
;
MON(DATA) ;EP - Month
NEW BI,TEXT
K @DATA
S II=0
S @DATA@(II)="T00010CODE^T00030"_$C(30)
F BI=1:1 S TEXT=$T(MLS+BI) Q:TEXT=" Q" D
. S TEXT=$P(TEXT,";;",2) I TEXT="" Q
. S II=II+1,@DATA@(II)=$P(TEXT,U,1)_U_$P(TEXT,U,2)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
MLS ;
;;01^January^Jan
;;02^February^Feb
;;03^March^Mar
;;04^April^Apr
;;05^May^May
;;06^June^Jun
;;07^July^Jul
;;08^August^Aug
;;09^September^Sep
;;10^October^Oct
;;11^November^Nov
;;12^December^Dec
Q
BQIUTB6 ;GDIT/HCSD/ALA-Table Utility ; 13 Jul 2015 8:00 AM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
+3 ;
TIME(DATA,PARM) ;EP - BQI GET TIMEFRAMES
+1 NEW UID,II,X
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP(UID,"BQITABLE"))
+4 KILL @DATA
+5 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+6 SET PARM=$GET(PARM,"")
IF PARM=""
QUIT
+7 ;
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIUTB D UNWIND^%ZTER"
+10 NEW LN,BZ,ORD,VAL
+11 KILL BZ
+12 SET II=0
SET LN=""
+13 SET @DATA@(II)="T00010CODE^T00060DESC"_$CHAR(30)
+14 SET ORD=""
+15 FOR
SET ORD=$ORDER(^BQI(90506.9,"D",PARM,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+16 SET LN=$ORDER(^BQI(90506.9,"D",PARM,ORD,""))
+17 IF LN'=""
SET VAL=$PIECE(^BQI(90506.9,LN,0),U,3)
+18 IF $EXTRACT(PARM,1,3)="IPM"!($EXTRACT(PARM,1,3)="IPW")
SET VAL=""
+19 SET II=II+1
SET @DATA@(II)=VAL_"^"_$PIECE(^BQI(90506.9,LN,0),U,1)_$CHAR(30)
End DoDot:1
+20 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+21 QUIT
+22 ;
MEAS(DATA) ;EP - Measurements
+1 NEW RN,COD,TYPE,VALUE
+2 SET II=0
SET RN=0
+3 SET @DATA@(II)="I00010IEN^T00030^T00010TYPE^T00030VALUE^T00003PARENT_IEN"_$CHAR(30)
+4 FOR
SET RN=$ORDER(^BQI(90507.2,RN))
IF 'RN
QUIT
Begin DoDot:1
+5 SET MN=$PIECE(^BQI(90507.2,RN,0),"^",3)
+6 IF $GET(^AUTTMSR(MN,0))=""
QUIT
+7 IF $PIECE(^AUTTMSR(MN,0),U,4)=1
QUIT
+8 ;I $P(^BQI(90507.2,RN,0),"^",1)="BLOOD PRESSURE"!($P(^BQI(90507.2,RN,0),"^",1)="ANKLE BLOOD PRESSURE") Q
+9 ;I $P(^BQI(90507.2,RN,0),"^",5)'="" Q
+10 SET TYPE=$$GET1^DIQ(90507.2,RN_",",.04,"E")
SET VALUE=""
+11 SET COD=$PIECE(^BQI(90507.2,RN,0),"^",2)
SET DESC=$PIECE(^(0),"^",1)
+12 IF TYPE["SET"
SET VALUE=$GET(^BQI(90507.2,RN,2))
+13 SET II=II+1
SET @DATA@(II)=RN_U_DESC_" ("_$EXTRACT(TYPE,1,1)_")"_U_TYPE_U_VALUE_U_$PIECE(^BQI(90507.2,RN,0),"^",5)_$CHAR(30)
End DoDot:1
+14 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+15 QUIT
+16 ;
MEASD(DATA,MIEN) ;EP - BQI GET MEASUREMENT DETAIL
+1 NEW UID,II,X,RN,MAX,MIN,HDR,COD,TYPE,VALUE,NDEC,TOOL
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP(UID,"BQIMEASD"))
+4 KILL @DATA
+5 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIUTB D UNWIND^%ZTER"
+7 SET II=0
+8 SET HDR="T00010IEN^T00030DESC^T00010TYPE^T00030VALUE^I00010NBOX^I00010B1MIN^I00010B1MAX^"
+9 SET HDR=HDR_"I00010B2MIN^I00010B2MAX^I00010NDEC^T00070TOOLTIP"
+10 SET @DATA@(II)=HDR_$CHAR(30)
+11 SET MIEN=$GET(MIEN,"")
+12 IF MIEN=""
Begin DoDot:1
+13 SET RN=0
+14 FOR
SET RN=$ORDER(^BQI(90507.2,RN))
IF 'RN
QUIT
Begin DoDot:2
+15 SET MN=$PIECE(^BQI(90507.2,RN,0),"^",3)
SET COD=$PIECE(^(0),U,2)
+16 IF $GET(^AUTTMSR(MN,0))=""
QUIT
+17 IF $PIECE(^AUTTMSR(MN,0),U,4)=1
QUIT
+18 ;I $P(^BQI(90507.2,RN,0),"^",1)["BLOOD PRESSURE" Q
+19 IF $PIECE(^BQI(90507.2,RN,0),"^",5)'=""
QUIT
+20 SET TOOL=$PIECE($GET(^BQI(90507.2,RN,3)),"^",1)
+21 DO MD(RN)
+22 SET II=II+1
SET @DATA@(II)=RN_U_COD_U_TYPE_U_VALUE_U_NBOX_U_BOX1MIN_U_BOX1MAX_U_BOX2MIN_U_BOX2MAX_U_NDEC_U_TOOL_$CHAR(30)
+23 IF $DATA(SUB)
SET N=""
FOR
SET N=$ORDER(SUB(N))
IF N=""
QUIT
SET II=II+1
SET @DATA@(II)=SUB(N)
+24 KILL SUB
End DoDot:2
End DoDot:1
+25 ;
+26 IF MIEN'=""
Begin DoDot:1
+27 SET COD=$PIECE(^BQI(90507.2,MIEN,0),"^",2)
+28 DO MD(MIEN)
+29 SET TOOL=$PIECE($GET(^BQI(90507.2,MIEN,3)),"^",1)
+30 SET II=II+1
SET @DATA@(II)=MIEN_U_COD_U_TYPE_U_VALUE_U_NBOX_U_BOX1MIN_U_BOX1MAX_U_BOX2MIN_U_BOX2MAX_U_NDEC_U_TOOL_$CHAR(30)
+31 IF $DATA(SUB)
SET N=""
FOR
SET N=$ORDER(SUB(N))
IF N=""
QUIT
SET II=II+1
SET @DATA@(II)=SUB(N)
+32 KILL SUB
End DoDot:1
+33 ;
+34 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+35 KILL TYPE,VALUE,NBOX,BOX1MIN,BOX1MAX,BOX2MIN,BOX2MAX,NDEC
+36 QUIT
+37 ;
MD(RN) ;EP
+1 NEW MDATA,MN,CT
+2 SET (TYPE,VALUE,NBOX,BOX1MIN,BOX2MIN,BOX1MAX,BOX2MAX,NDEC)=""
+3 SET TYPE=$$GET1^DIQ(90507.2,RN_",",.04,"E")
+4 IF TYPE["SET"
SET VALUE=$GET(^BQI(90507.2,RN,2))
+5 SET MDATA=$GET(^BQI(90507.2,RN,1))
+6 SET TOOL=$PIECE($GET(^BQI(90507.2,RN,3)),"^",1)
+7 SET NBOX=$PIECE(MDATA,"^",1)
SET NDEC=$PIECE(MDATA,"^",18)
+8 IF NBOX=1
SET BOX1MIN=$PIECE(MDATA,"^",2)
SET BOX1MAX=$PIECE(MDATA,"^",3)
+9 IF NBOX=2
SET BOX1MIN=$PIECE(MDATA,"^",2)
SET BOX1MAX=$PIECE(MDATA,"^",3)
SET BOX2MIN=$PIECE(MDATA,"^",4)
SET BOX2MAX=$PIECE(MDATA,"^",5)
+10 SET MN=""
SET CT=0
FOR
SET MN=$ORDER(^BQI(90507.2,"AD",RN,MN))
IF MN=""
QUIT
Begin DoDot:1
+11 SET CT=CT+1
SET SUB(CT)=MN_U_$PIECE(^BQI(90507.2,MN,0),"^",2)_U_$$GET1^DIQ(90507.2,MN_",",.04,"E")_U_$GET(^BQI(90507.2,MN,2))_"^^^^^^"_U_TOOL_$CHAR(30)
End DoDot:1
+12 QUIT
+13 ;
MON(DATA) ;EP - Month
+1 NEW BI,TEXT
+2 KILL @DATA
+3 SET II=0
+4 SET @DATA@(II)="T00010CODE^T00030"_$CHAR(30)
+5 FOR BI=1:1
SET TEXT=$TEXT(MLS+BI)
IF TEXT=" Q"
QUIT
Begin DoDot:1
+6 SET TEXT=$PIECE(TEXT,";;",2)
IF TEXT=""
QUIT
+7 SET II=II+1
SET @DATA@(II)=$PIECE(TEXT,U,1)_U_$PIECE(TEXT,U,2)_$CHAR(30)
End DoDot:1
+8 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+9 QUIT
+10 ;
MLS ;
+1 ;;01^January^Jan
+2 ;;02^February^Feb
+3 ;;03^March^Mar
+4 ;;04^April^Apr
+5 ;;05^May^May
+6 ;;06^June^Jun
+7 ;;07^July^Jul
+8 ;;08^August^Aug
+9 ;;09^September^Sep
+10 ;;10^October^Oct
+11 ;;11^November^Nov
+12 ;;12^December^Dec
+13 QUIT
