BQIIPPT ;VNGT/HS/ALA-IPC Patient Detail ; 30 Jun 2011 12:32 PM
;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
;
;
EN(DATA,OWNR,PLIEN,CRIPC,PLIST) ;EP - BQI GET IPC PATIENT DETAIL
;Description - Entry point for the panel
;Input Parameters
; OWNR - Owner of panel
; PLIEN - Panel IEN
; PLIST - List of DFNs (optional)
NEW UID,II,X,PGIEN,STVWCD,TDATA
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIGPPNL",UID)) K @DATA
S TDATA=$NA(^TMP("BQIPTIP",UID)) K @TDATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIGPRA1 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
; get the current IPC definition
S CRIPC=$G(CRIPC,"")
I CRIPC="" S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
S CRN=$O(^BQI(90508,1,22,"B",CRIPC,"")) I CRN="" Q
;
; If a list of DFNs, process them instead of entire panel
I $D(PLIST)>0 D G DONE
. I $D(PLIST)>1 D
.. S LIST="",BN=""
.. F S BN=$O(PLIST(BN)) Q:BN="" S LIST=LIST_PLIST(BN)
.. K PLIST S PLIST=LIST
. F BQI=1:1 S DFN=$P(PLIST,$C(28),BQI) Q:DFN="" D
.. I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q
.. D PAT(.DATA,OWNR,PLIEN,DFN)
;
S DFN=0
I $O(^BQICARE(OWNR,1,PLIEN,40,DFN))="" D PAT(.DATA,OWNR,PLIEN,"") G DONE
;
F S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN D
. I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q
. D PAT(.DATA,OWNR,PLIEN,DFN)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
K @TDATA
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
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
PAT(DATA,OWNR,PLIEN,DFN) ;EP - Build record by patient
NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,VAL,BQIDOD,PROV,PAT,CAT,TITLE,MSN
S VALUE=""
I DFN'="" S Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I"),HDOB=$$FMTE^BQIUL1(Y)
I DFN'="" S VALUE=DFN_"^"_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_"^"_$$SENS^BQIULPT(DFN)_"^"_$$CALR^BQIULPT(DFN)_"^"_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_"^"_HDOB_"^"
S HEADR="I00010DFN^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030DOB^"
S HEADR=HEADR_"T00030PN^T00040HRN^T00035DPCP^D00030LVD^D00030LVDPCP^D00030NAPD^"
I DFN'="" S VAL=$$HRNL^BQIULPT(DFN),VAL=$TR(VAL,";",$C(10))
I DFN'="" S PROV=$P($$DPCP^BQIULPT(DFN),U,2) I PROV="" S PROV="{NOT ASSIGNED}"
I DFN'="" S VALUE=VALUE_$P($G(^DPT(DFN,0)),"^",1)_"^"_VAL_"^"_PROV_"^"_$$LVDT^BQIULPT(DFN)_"^"_$$LVDPCP^BQIULPT(DFN)_"^"_$$NAD^BQIULPT(DFN)_"^"
I DFN'="" S BQIDOD=$$GET1^DIQ(2,DFN_",",.351,"I") ; Is patient deceased?
;
D REC(DFN)
;
I DFN'="" D
. S PAT=DFN,ORD=""
. F S ORD=$O(@TDATA@(PAT,ORD)) Q:ORD="" D
.. S VAL=$G(@TDATA@(PAT,ORD,"VAL"))
.. S HDR=$G(@TDATA@(PAT,ORD,"HDR"))
.. D UP
;
; remove trailing up-arrows
S HEADR=$$TKO^BQIUL1(HEADR,"^")
S VALUE=$$TKO^BQIUL1(VALUE,"^")
;
I DFN="" S VALUE=""
;
I II=0 S @DATA@(II)=HEADR_$C(30)
I VALUE'="" S II=II+1,@DATA@(II)=VALUE_$C(30)
;
Q
;
GVAL ;EP - Get GPRA value for patient
NEW PIEN,DEN,NUM,SPVW,SPIEN,VER
I $G(BQIMEASF)="" D INP^BQINIGHT
I $G(DFN)="" S VAL="",HDR="T00003"_STVW,GMET="" Q
S PIEN=$O(^BQIPAT(DFN,30,"B",STVW,""))
I PIEN="" S VAL=$S(BQIDOD'="":"{D}",1:"NDA"),HDR="T00003"_STVW,GMET="" Q
;
I $G(BQIH)="" S BQIH=$$SPM^BQIGPUTL()
I $G(BQIYR)="" S BQIYR=$$GET1^DIQ(90508,BQIH_",",2,"E")
S BQIY=$$LKP^BQIGPUTL(BQIYR)
;
S VER=$$VERSION^XPDUTL("BGP")
S SPVW=$P(STVW,"_",2),NAFLG=0
S NAFLG=$$GET1^DIQ(BQIMEASF,SPVW_",",1704,"I")
S NAFLG=$S(NAFLG="Y":1,1:0)
;
S DEN=$P(^BQIPAT(DFN,30,PIEN,0),U,4)
S NUM=+$P(^BQIPAT(DFN,30,PIEN,0),U,3)
;
I DEN="" D
. I NAFLG'=1 S VAL="N/A" Q
. I 'NUM S VAL=0,GMET=0 Q
. S VAL=NUM
I DEN D
. I 'NUM S VAL="NO",GMET=0 Q
. S VAL="YES"
S HDR="T00003"_STVW
I BQIDOD'="" S VAL="{D}"
Q
;
UP ;EP
S VALUE=VALUE_$G(VAL)_"^"
S HEADR=HEADR_HDR_"^"
Q
;
REC(DFN) ;EP - Record
S ORD=""
F S ORD=$O(^BQI(90508,1,22,CRN,1,"C",ORD)) Q:ORD="" D
. S MSN=""
. F S MSN=$O(^BQI(90508,1,22,CRN,1,"C",ORD,MSN)) Q:'MSN D
.. S IDATA=^BQI(90508,1,22,CRN,1,MSN,0)
.. S CODE=$P(IDATA,U,1),TYP=$P(IDATA,U,2),TITLE=$P(IDATA,U,4),TAB=$P(IDATA,U,13)
.. I TAB="A" Q
.. ; If inactive, quit
.. I $P(IDATA,U,7)=1 Q
.. S HDR="T00003"_CODE I DFN="" S HEADR=HEADR_HDR_"^" Q
.. NEW DA,IENS
.. S DA(2)=1,DA(1)=CRN,DA=MSN,IENS=$$IENS^DILF(.DA)
.. S CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
.. S MSIEN=$O(^BQI(90506.1,"B",CODE,""))
.. I CAT="",MSIEN'="" S CAT=$$GET1^DIQ(90506.1,MSIEN_",",3.03,"E")
.. I CAT="" S CAT="~"
.. I $P(IDATA,U,5)'="B" S CAT=CAT_"_2"
.. I TYP="R",$P(IDATA,U,5)="B" D
... K XX
... I CODE="IPC_OUTC" D
.... I DFN'="" S VAL=$$OPAT^BQIIPOTC(CRN,DFN)
... I CODE["CTRL" D
.... I DFN'="" S VAL=$$PAT^BQIIPOTC(CRN,DFN,CODE)
... I CODE'="IPC_OUTC",CODE'["CTRL" D
.... D BUN^BQIIPBNL(CRN,MSN,.XX)
.... I DFN'="" S VAL=$$PAT^BQIIPBNL(DFN,.XX)
... S CAT=CAT_"_1"
... D STOR(ORD)
.. I TYP'="G" Q
.. S STVW=CODE
.. D GVAL
.. D STOR(ORD)
Q
;
STOR(ORD) ;EP
I DFN="" Q
S @TDATA@(DFN,ORD,"VAL")=$G(VAL)
S @TDATA@(DFN,ORD,"HDR")=$G(HDR)
Q
BQIIPPT ;VNGT/HS/ALA-IPC Patient Detail ; 30 Jun 2011 12:32 PM
+1 ;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
+2 ;
+3 ;
EN(DATA,OWNR,PLIEN,CRIPC,PLIST) ;EP - BQI GET IPC PATIENT DETAIL
+1 ;Description - Entry point for the panel
+2 ;Input Parameters
+3 ; OWNR - Owner of panel
+4 ; PLIEN - Panel IEN
+5 ; PLIST - List of DFNs (optional)
+6 NEW UID,II,X,PGIEN,STVWCD,TDATA
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET DATA=$NAME(^TMP("BQIGPPNL",UID))
KILL @DATA
+9 SET TDATA=$NAME(^TMP("BQIPTIP",UID))
KILL @TDATA
+10 ;
+11 SET II=0
+12 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIGPRA1 D UNWIND^%ZTER"
+13 ;
+14 ; get the current IPC definition
+15 SET CRIPC=$GET(CRIPC,"")
+16 IF CRIPC=""
SET CRIPC=$PIECE($GET(^BQI(90508,1,11)),U,1)
+17 SET CRN=$ORDER(^BQI(90508,1,22,"B",CRIPC,""))
IF CRN=""
QUIT
+18 ;
+19 ; If a list of DFNs, process them instead of entire panel
+20 IF $DATA(PLIST)>0
Begin DoDot:1
+21 IF $DATA(PLIST)>1
Begin DoDot:2
+22 SET LIST=""
SET BN=""
+23 FOR
SET BN=$ORDER(PLIST(BN))
IF BN=""
QUIT
SET LIST=LIST_PLIST(BN)
+24 KILL PLIST
SET PLIST=LIST
End DoDot:2
+25 FOR BQI=1:1
SET DFN=$PIECE(PLIST,$CHAR(28),BQI)
IF DFN=""
QUIT
Begin DoDot:2
+26 IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"
QUIT
+27 DO PAT(.DATA,OWNR,PLIEN,DFN)
End DoDot:2
End DoDot:1
GOTO DONE
+28 ;
+29 SET DFN=0
+30 IF $ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))=""
DO PAT(.DATA,OWNR,PLIEN,"")
GOTO DONE
+31 ;
+32 FOR
SET DFN=$ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+33 IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"
QUIT
+34 DO PAT(.DATA,OWNR,PLIEN,DFN)
End DoDot:1
+35 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 KILL @TDATA
+3 QUIT
+4 ;
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 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
PAT(DATA,OWNR,PLIEN,DFN) ;EP - Build record by patient
+1 NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,VAL,BQIDOD,PROV,PAT,CAT,TITLE,MSN
+2 SET VALUE=""
+3 IF DFN'=""
SET Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I")
SET HDOB=$$FMTE^BQIUL1(Y)
+4 IF DFN'=""
SET VALUE=DFN_"^"_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_"^"_$$SENS^BQIULPT(DFN)_"^"_$$CALR^BQIULPT(DFN)_"^"_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_"^"_HDOB_"^"
+5 SET HEADR="I00010DFN^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030DOB^"
+6 SET HEADR=HEADR_"T00030PN^T00040HRN^T00035DPCP^D00030LVD^D00030LVDPCP^D00030NAPD^"
+7 IF DFN'=""
SET VAL=$$HRNL^BQIULPT(DFN)
SET VAL=$TRANSLATE(VAL,";",$CHAR(10))
+8 IF DFN'=""
SET PROV=$PIECE($$DPCP^BQIULPT(DFN),U,2)
IF PROV=""
SET PROV="{NOT ASSIGNED}"
+9 IF DFN'=""
SET VALUE=VALUE_$PIECE($GET(^DPT(DFN,0)),"^",1)_"^"_VAL_"^"_PROV_"^"_$$LVDT^BQIULPT(DFN)_"^"_$$LVDPCP^BQIULPT(DFN)_"^"_$$NAD^BQIULPT(DFN)_"^"
+10 ; Is patient deceased?
IF DFN'=""
SET BQIDOD=$$GET1^DIQ(2,DFN_",",.351,"I")
+11 ;
+12 DO REC(DFN)
+13 ;
+14 IF DFN'=""
Begin DoDot:1
+15 SET PAT=DFN
SET ORD=""
+16 FOR
SET ORD=$ORDER(@TDATA@(PAT,ORD))
IF ORD=""
QUIT
Begin DoDot:2
+17 SET VAL=$GET(@TDATA@(PAT,ORD,"VAL"))
+18 SET HDR=$GET(@TDATA@(PAT,ORD,"HDR"))
+19 DO UP
End DoDot:2
End DoDot:1
+20 ;
+21 ; remove trailing up-arrows
+22 SET HEADR=$$TKO^BQIUL1(HEADR,"^")
+23 SET VALUE=$$TKO^BQIUL1(VALUE,"^")
+24 ;
+25 IF DFN=""
SET VALUE=""
+26 ;
+27 IF II=0
SET @DATA@(II)=HEADR_$CHAR(30)
+28 IF VALUE'=""
SET II=II+1
SET @DATA@(II)=VALUE_$CHAR(30)
+29 ;
+30 QUIT
+31 ;
GVAL ;EP - Get GPRA value for patient
+1 NEW PIEN,DEN,NUM,SPVW,SPIEN,VER
+2 IF $GET(BQIMEASF)=""
DO INP^BQINIGHT
+3 IF $GET(DFN)=""
SET VAL=""
SET HDR="T00003"_STVW
SET GMET=""
QUIT
+4 SET PIEN=$ORDER(^BQIPAT(DFN,30,"B",STVW,""))
+5 IF PIEN=""
SET VAL=$SELECT(BQIDOD'="":"{D}",1:"NDA")
SET HDR="T00003"_STVW
SET GMET=""
QUIT
+6 ;
+7 IF $GET(BQIH)=""
SET BQIH=$$SPM^BQIGPUTL()
+8 IF $GET(BQIYR)=""
SET BQIYR=$$GET1^DIQ(90508,BQIH_",",2,"E")
+9 SET BQIY=$$LKP^BQIGPUTL(BQIYR)
+10 ;
+11 SET VER=$$VERSION^XPDUTL("BGP")
+12 SET SPVW=$PIECE(STVW,"_",2)
SET NAFLG=0
+13 SET NAFLG=$$GET1^DIQ(BQIMEASF,SPVW_",",1704,"I")
+14 SET NAFLG=$SELECT(NAFLG="Y":1,1:0)
+15 ;
+16 SET DEN=$PIECE(^BQIPAT(DFN,30,PIEN,0),U,4)
+17 SET NUM=+$PIECE(^BQIPAT(DFN,30,PIEN,0),U,3)
+18 ;
+19 IF DEN=""
Begin DoDot:1
+20 IF NAFLG'=1
SET VAL="N/A"
QUIT
+21 IF 'NUM
SET VAL=0
SET GMET=0
QUIT
+22 SET VAL=NUM
End DoDot:1
+23 IF DEN
Begin DoDot:1
+24 IF 'NUM
SET VAL="NO"
SET GMET=0
QUIT
+25 SET VAL="YES"
End DoDot:1
+26 SET HDR="T00003"_STVW
+27 IF BQIDOD'=""
SET VAL="{D}"
+28 QUIT
+29 ;
UP ;EP
+1 SET VALUE=VALUE_$GET(VAL)_"^"
+2 SET HEADR=HEADR_HDR_"^"
+3 QUIT
+4 ;
REC(DFN) ;EP - Record
+1 SET ORD=""
+2 FOR
SET ORD=$ORDER(^BQI(90508,1,22,CRN,1,"C",ORD))
IF ORD=""
QUIT
Begin DoDot:1
+3 SET MSN=""
+4 FOR
SET MSN=$ORDER(^BQI(90508,1,22,CRN,1,"C",ORD,MSN))
IF 'MSN
QUIT
Begin DoDot:2
+5 SET IDATA=^BQI(90508,1,22,CRN,1,MSN,0)
+6 SET CODE=$PIECE(IDATA,U,1)
SET TYP=$PIECE(IDATA,U,2)
SET TITLE=$PIECE(IDATA,U,4)
SET TAB=$PIECE(IDATA,U,13)
+7 IF TAB="A"
QUIT
+8 ; If inactive, quit
+9 IF $PIECE(IDATA,U,7)=1
QUIT
+10 SET HDR="T00003"_CODE
IF DFN=""
SET HEADR=HEADR_HDR_"^"
QUIT
+11 NEW DA,IENS
+12 SET DA(2)=1
SET DA(1)=CRN
SET DA=MSN
SET IENS=$$IENS^DILF(.DA)
+13 SET CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
+14 SET MSIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
+15 IF CAT=""
IF MSIEN'=""
SET CAT=$$GET1^DIQ(90506.1,MSIEN_",",3.03,"E")
+16 IF CAT=""
SET CAT="~"
+17 IF $PIECE(IDATA,U,5)'="B"
SET CAT=CAT_"_2"
+18 IF TYP="R"
IF $PIECE(IDATA,U,5)="B"
Begin DoDot:3
+19 KILL XX
+20 IF CODE="IPC_OUTC"
Begin DoDot:4
+21 IF DFN'=""
SET VAL=$$OPAT^BQIIPOTC(CRN,DFN)
End DoDot:4
+22 IF CODE["CTRL"
Begin DoDot:4
+23 IF DFN'=""
SET VAL=$$PAT^BQIIPOTC(CRN,DFN,CODE)
End DoDot:4
+24 IF CODE'="IPC_OUTC"
IF CODE'["CTRL"
Begin DoDot:4
+25 DO BUN^BQIIPBNL(CRN,MSN,.XX)
+26 IF DFN'=""
SET VAL=$$PAT^BQIIPBNL(DFN,.XX)
End DoDot:4
+27 SET CAT=CAT_"_1"
+28 DO STOR(ORD)
End DoDot:3
+29 IF TYP'="G"
QUIT
+30 SET STVW=CODE
+31 DO GVAL
+32 DO STOR(ORD)
End DoDot:2
End DoDot:1
+33 QUIT
+34 ;
STOR(ORD) ;EP
+1 IF DFN=""
QUIT
+2 SET @TDATA@(DFN,ORD,"VAL")=$GET(VAL)
+3 SET @TDATA@(DFN,ORD,"HDR")=$GET(HDR)
+4 QUIT
