BTPWRLAB ;VNGT/HS/ALA-Lab Result Report ; 05 Apr 2010 9:28 AM
;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
;
EN(DATA,DFN,IEN) ; EP - BTPW LAB RESULT DISPLAY
; Description
; Generates a display of lab data
; Input
; DFN - Patient IEN
; IEN - Lab record IEN
;
NEW ACCN,VISIT,LRDFN,TEST,LOC,NOD,NUM,PEC,DTM,QFL,DAT,NUN,VAL,DTYP,NAME,VEDAT,VEQFL
NEW VEVL,VALUE,CSTAT,LC,VEDATA,NFL,PNL,CRES
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWRLAB",UID))
K @DATA
;
S II=0
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWRLAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
D HDR
;
S ACCN=$P($G(^AUPNVLAB(IEN,0)),U,6),VISIT=$P($G(^AUPNVLAB(IEN,0)),U,3)
I $E(ACCN,1,2)="WH" D Q
. S BWACN=$E(ACCN,3,$L(ACCN)),WHIEN=$O(^BWPCD("B",BWACN,"")) I WHIEN="" Q
. D EN^BTPWRWHP(.DATA,WHIEN)
S LRDFN=$P($G(^DPT(DFN,"LR")),U,1),TEST=$P($G(^AUPNVLAB(IEN,0)),U,1)
I TEST="" G DONE
;I LRDFN="" G DONE
S CSTAT=$$GET1^DIQ(9000010.09,IEN_",",1109,"E")
S CRES=$$GET1^DIQ(9000010.09,IEN_",",.04,"E")
S II=II+1,@DATA@(II)=" Current Status: "_CSTAT_$C(13)_$C(10)
S II=II+1,@DATA@(II)=" Result: "_CRES_$C(13)_$C(10)
S LOC=$P(^LAB(60,TEST,0),U,5),NOD=$P(LOC,";",1),NUM=$P(LOC,";",2),PEC=$P(LOC,";",3)
I PEC="" S PEC=1
I LOC="" S NOD=$P(^LAB(60,TEST,0),U,4)
I LRDFN'="" D
. S DTM=0,QFL=0,DAT=""
. F S DTM=$O(^LR(LRDFN,NOD,DTM)) Q:DTM="" D Q:QFL
.. I $P(^LR(LRDFN,NOD,DTM,0),U,6)=ACCN S QFL=1,DAT=DTM
. I NUM="" S NUN=1
. E S NUN=NUM-.005
. I DAT'="" D
.. F S NUN=$O(^LR(LRDFN,NOD,DAT,NUN)) Q:'NUN D
... I NOD="CH" D
.... I $G(^LR(LRDFN,NOD,DAT,NUN))="" Q
.... S VAL=$P(^LR(LRDFN,NOD,DAT,NUN),U,PEC)
.... S DTYP=$P($G(^DD(63.04,NUN,0)),U,2),DTYP=$S(DTYP["N":"N",DTYP["S":"S",1:"F")
.... S NAME=$P($G(^DD(63.04,NUN,0)),U,1)
.... I DTYP="S" D
..... S VEDATA=$P(^DD(63.04,NUN,0),U,3),VEQFL=0
..... F I=1:1 S VEVL=$P(VEDATA,";",I) Q:VEVL="" D Q:VEQFL
...... S VALUE=$P(VEVL,":",2) I VAL=$P(VEVL,":",1) S VEQFL=1,VAL=VALUE
.... S II=II+1,@DATA@(II)=" "_NAME_$S(NAME[":":" ",1:": ")_VAL_$C(13)_$C(10)
S LC=0
F S LC=$O(^AUPNVLAB(IEN,21,LC)) Q:'LC S II=II+1,@DATA@(II)=^AUPNVLAB(IEN,21,LC,0)_$C(13)_$C(10)
; check if lab is a panel
S PNL=$O(^LAB(60,TEST,2,0))
I PNL D
. NEW PIEN,LIEN,PLAB
. K MEM
. S PIEN=0 F S PIEN=$O(^LAB(60,TEST,2,PIEN)) Q:'PIEN S PLAB=$P(^LAB(60,TEST,2,PIEN,0),U,1),MEM(PLAB)=""
. S LIEN="",NFL=0
. F S LIEN=$O(^AUPNVLAB("AD",VISIT,LIEN)) Q:LIEN="" D Q:NFL
.. ;S PLAB=$P(^AUPNVLAB(LIEN,0),U,1) I '$D(MEM(PLAB)) Q
.. I $P($G(^AUPNVLAB(LIEN,0)),U,6)'=ACCN Q
.. ;I $P(^AUPNVLAB(LIEN,0),U,4)'="FINAL" Q
.. S LC=0
.. I $O(^AUPNVLAB(LIEN,21,LC))'="" S II=II+1,@DATA@(II)="NOTE: "_$C(13)_$C(10)
.. F S LC=$O(^AUPNVLAB(LIEN,21,LC)) Q:'LC S II=II+1,@DATA@(II)=^AUPNVLAB(LIEN,21,LC,0)_$C(13)_$C(10),NFL=1
S II=II+1,@DATA@(II)=$C(30)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
HDR ;
S @DATA@(II)="T01024REPORT_TEXT"_$C(30)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
S II=II+1,@DATA@(II)=$C(31)
I $$TMPFL^BQIUL1("C")
Q
BTPWRLAB ;VNGT/HS/ALA-Lab Result Report ; 05 Apr 2010 9:28 AM
+1 ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
+2 ;
EN(DATA,DFN,IEN) ; EP - BTPW LAB RESULT DISPLAY
+1 ; Description
+2 ; Generates a display of lab data
+3 ; Input
+4 ; DFN - Patient IEN
+5 ; IEN - Lab record IEN
+6 ;
+7 NEW ACCN,VISIT,LRDFN,TEST,LOC,NOD,NUM,PEC,DTM,QFL,DAT,NUN,VAL,DTYP,NAME,VEDAT,VEQFL
+8 NEW VEVL,VALUE,CSTAT,LC,VEDATA,NFL,PNL,CRES
+9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+10 SET DATA=$NAME(^TMP("BTPWRLAB",UID))
+11 KILL @DATA
+12 ;
+13 SET II=0
+14 ;
+15 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWRLAB D UNWIND^%ZTER"
+16 ;
+17 DO HDR
+18 ;
+19 SET ACCN=$PIECE($GET(^AUPNVLAB(IEN,0)),U,6)
SET VISIT=$PIECE($GET(^AUPNVLAB(IEN,0)),U,3)
+20 IF $EXTRACT(ACCN,1,2)="WH"
Begin DoDot:1
+21 SET BWACN=$EXTRACT(ACCN,3,$LENGTH(ACCN))
SET WHIEN=$ORDER(^BWPCD("B",BWACN,""))
IF WHIEN=""
QUIT
+22 DO EN^BTPWRWHP(.DATA,WHIEN)
End DoDot:1
QUIT
+23 SET LRDFN=$PIECE($GET(^DPT(DFN,"LR")),U,1)
SET TEST=$PIECE($GET(^AUPNVLAB(IEN,0)),U,1)
+24 IF TEST=""
GOTO DONE
+25 ;I LRDFN="" G DONE
+26 SET CSTAT=$$GET1^DIQ(9000010.09,IEN_",",1109,"E")
+27 SET CRES=$$GET1^DIQ(9000010.09,IEN_",",.04,"E")
+28 SET II=II+1
SET @DATA@(II)=" Current Status: "_CSTAT_$CHAR(13)_$CHAR(10)
+29 SET II=II+1
SET @DATA@(II)=" Result: "_CRES_$CHAR(13)_$CHAR(10)
+30 SET LOC=$PIECE(^LAB(60,TEST,0),U,5)
SET NOD=$PIECE(LOC,";",1)
SET NUM=$PIECE(LOC,";",2)
SET PEC=$PIECE(LOC,";",3)
+31 IF PEC=""
SET PEC=1
+32 IF LOC=""
SET NOD=$PIECE(^LAB(60,TEST,0),U,4)
+33 IF LRDFN'=""
Begin DoDot:1
+34 SET DTM=0
SET QFL=0
SET DAT=""
+35 FOR
SET DTM=$ORDER(^LR(LRDFN,NOD,DTM))
IF DTM=""
QUIT
Begin DoDot:2
+36 IF $PIECE(^LR(LRDFN,NOD,DTM,0),U,6)=ACCN
SET QFL=1
SET DAT=DTM
End DoDot:2
IF QFL
QUIT
+37 IF NUM=""
SET NUN=1
+38 IF '$TEST
SET NUN=NUM-.005
+39 IF DAT'=""
Begin DoDot:2
+40 FOR
SET NUN=$ORDER(^LR(LRDFN,NOD,DAT,NUN))
IF 'NUN
QUIT
Begin DoDot:3
+41 IF NOD="CH"
Begin DoDot:4
+42 IF $GET(^LR(LRDFN,NOD,DAT,NUN))=""
QUIT
+43 SET VAL=$PIECE(^LR(LRDFN,NOD,DAT,NUN),U,PEC)
+44 SET DTYP=$PIECE($GET(^DD(63.04,NUN,0)),U,2)
SET DTYP=$SELECT(DTYP["N":"N",DTYP["S":"S",1:"F")
+45 SET NAME=$PIECE($GET(^DD(63.04,NUN,0)),U,1)
+46 IF DTYP="S"
Begin DoDot:5
+47 SET VEDATA=$PIECE(^DD(63.04,NUN,0),U,3)
SET VEQFL=0
+48 FOR I=1:1
SET VEVL=$PIECE(VEDATA,";",I)
IF VEVL=""
QUIT
Begin DoDot:6
+49 SET VALUE=$PIECE(VEVL,":",2)
IF VAL=$PIECE(VEVL,":",1)
SET VEQFL=1
SET VAL=VALUE
End DoDot:6
IF VEQFL
QUIT
End DoDot:5
+50 SET II=II+1
SET @DATA@(II)=" "_NAME_$SELECT(NAME[":":" ",1:": ")_VAL_$CHAR(13)_$CHAR(10)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+51 SET LC=0
+52 FOR
SET LC=$ORDER(^AUPNVLAB(IEN,21,LC))
IF 'LC
QUIT
SET II=II+1
SET @DATA@(II)=^AUPNVLAB(IEN,21,LC,0)_$CHAR(13)_$CHAR(10)
+53 ; check if lab is a panel
+54 SET PNL=$ORDER(^LAB(60,TEST,2,0))
+55 IF PNL
Begin DoDot:1
+56 NEW PIEN,LIEN,PLAB
+57 KILL MEM
+58 SET PIEN=0
FOR
SET PIEN=$ORDER(^LAB(60,TEST,2,PIEN))
IF 'PIEN
QUIT
SET PLAB=$PIECE(^LAB(60,TEST,2,PIEN,0),U,1)
SET MEM(PLAB)=""
+59 SET LIEN=""
SET NFL=0
+60 FOR
SET LIEN=$ORDER(^AUPNVLAB("AD",VISIT,LIEN))
IF LIEN=""
QUIT
Begin DoDot:2
+61 ;S PLAB=$P(^AUPNVLAB(LIEN,0),U,1) I '$D(MEM(PLAB)) Q
+62 IF $PIECE($GET(^AUPNVLAB(LIEN,0)),U,6)'=ACCN
QUIT
+63 ;I $P(^AUPNVLAB(LIEN,0),U,4)'="FINAL" Q
+64 SET LC=0
+65 IF $ORDER(^AUPNVLAB(LIEN,21,LC))'=""
SET II=II+1
SET @DATA@(II)="NOTE: "_$CHAR(13)_$CHAR(10)
+66 FOR
SET LC=$ORDER(^AUPNVLAB(LIEN,21,LC))
IF 'LC
QUIT
SET II=II+1
SET @DATA@(II)=^AUPNVLAB(LIEN,21,LC,0)_$CHAR(13)_$CHAR(10)
SET NFL=1
End DoDot:2
IF NFL
QUIT
End DoDot:1
+67 SET II=II+1
SET @DATA@(II)=$CHAR(30)
+68 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
HDR ;
+1 SET @DATA@(II)="T01024REPORT_TEXT"_$CHAR(30)
+2 QUIT
+3 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 IF $$TMPFL^BQIUL1("C")
+7 QUIT
