- 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
