BQIPLVWP ;PRXM/HC/ALA-Get Patient Data by View ; 17 Oct 2005 4:49 PM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
Q
;
EN(DATA,OWNR,PLIEN,DFN) ;EP - Starting point
;
;Description
; Builds the header and data string in the panel
; display order. If a customized view exists, it
; builds it, otherwise it builds the standard.
;Input
; OWNR - owner of the panel
; PLIEN - panel internal entry number
; PLIST - List of patient IENs separated by $C(28)
; DATA - Global reference
;Expects
; DUZ - person signed onto system
; II - counter variable
;
; if the user is the owner of the panel, use the owner's display order
NEW BQI,CTYP,SRC,HEADR,VALUE,QFL,KEY,VCODE
S CTYP="D",SRC=$O(^BQI(90506.5,"C",CTYP,""))
S HEADR="I00010DFN^T00001TICKLER_INDICATOR^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^",VALUE=""
I $G(DFN)'="" S VALUE=DFN_U_$$FLG^BTPWPPAT(DFN)_U_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_U_$$SENS^BQIULPT(DFN)_U_$$CALR^BQIULPT(DFN)_U_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_U
; Check for template
NEW DA,IENS,TEMPL,LYIEN,VWIEN
S TEMPL=""
I OWNR'=DUZ D
. S DA=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,"C",CTYP,""))
. I DA="" Q
. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,IENS=$$IENS^DILF(.DA)
. S TEMPL=$$GET1^DIQ(90505.34,IENS,.01,"E")
I OWNR=DUZ D
. S DA=$O(^BQICARE(OWNR,1,PLIEN,4,"C",CTYP,""))
. I DA="" Q
. S DA(2)=OWNR,DA(1)=PLIEN,IENS=$$IENS^DILF(.DA)
. S TEMPL=$$GET1^DIQ(90505.14,IENS,.01,"E")
;
; If template, use it
I TEMPL'="" S TQFL=0 D G FIN:'TQFL
. S LYIEN=$$TPN^BQILYUTL(DUZ,TEMPL)
. I LYIEN="" S TQFL=1 Q
. S DOR=""
. F S DOR=$O(^BQICARE(DUZ,15,LYIEN,1,"C",DOR)) Q:DOR="" D
.. S VWIEN=""
.. F S VWIEN=$O(^BQICARE(DUZ,15,LYIEN,1,"C",DOR,VWIEN)) Q:VWIEN="" D
... S VCODE=$P(^BQICARE(DUZ,15,LYIEN,1,VWIEN,0),U,1)
... S GIEN=$O(^BQI(90506.1,"B",VCODE,"")) I GIEN="" Q
... S KEY=$$GET1^DIQ(90506.1,GIEN_",",3.1,"E")
... I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
... S STVW=GIEN
... ; if the field has been inactivated, don't get data
... I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
... D GVAL
... S VALUE=VALUE_VAL_"^"
... S HEADR=HEADR_HDR_"^"
... K VAL,HDR
;
; If no template, check for customized
;
I OWNR=DUZ D
. S VWIEN=0,CIEN=$O(^BQICARE(OWNR,1,PLIEN,20,VWIEN))
. I CIEN'="" D Q
.. F S VWIEN=$O(^BQICARE(OWNR,1,PLIEN,20,VWIEN)) Q:'VWIEN D
... NEW DA,IENS,STVW
... S DA(2)=OWNR,DA(1)=PLIEN,DA=VWIEN,IENS=$$IENS^DILF(.DA)
... S VCODE=$$GET1^DIQ(90505.05,IENS,.01,"I")
... S STVW=$O(^BQI(90506.1,"B",VCODE,"")) I STVW="" Q
... ; if the field has been inactivated, don't get data
... I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
... ; if the source does not match, quit
... I $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC Q
... S KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
... I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
... D GVAL
... S VALUE=VALUE_VAL_"^"
... S HEADR=HEADR_HDR_"^"
... K VAL,HDR
. ;
. ; If no customized found, use default
. I CIEN="" D STAND()
;
I OWNR'=DUZ D
. S VWIEN=0,CIEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,VWIEN))
. I CIEN'="" D Q
.. F S VWIEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,VWIEN)) Q:'VWIEN D
... NEW DA,IENS,STVW
... S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,DA=VWIEN
... S IENS=$$IENS^DILF(.DA)
... S VCODE=$$GET1^DIQ(90505.06,IENS,.01,"I")
... S STVW=$O(^BQI(90506.1,"B",VCODE,"")) I STVW="" Q
... ; if the field has been inactivated, don't get data
... I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
... ; if the source does not match, quit
... I $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC Q
... S KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
... I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
... D GVAL
... S VALUE=VALUE_VAL_"^"
... S HEADR=HEADR_HDR_"^"
... K VAL,HDR
. ;
. ; If no customized found, use default
. I CIEN="" D STAND()
;
FIN ; Finish
; 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) K VALUE
K HEADR
Q
;
STAND() ;EP - Get standard display
NEW VWIEN,HDR,SENS
S HEADR="I00010DFN^T00001TICKLER_INDICATOR^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^",VALUE=""
I $G(DFN)'="" S VALUE=DFN_U_$$FLG^BTPWPPAT(DFN)_U_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_U_$$SENS^BQIULPT(DFN)_U_$$CALR^BQIULPT(DFN)_U_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_U
;
S ORD=""
F S ORD=$O(^BQI(90506.1,"AD","D",ORD)) Q:ORD="" D
. S VWIEN=""
. F S VWIEN=$O(^BQI(90506.1,"AD","D",ORD,VWIEN)) Q:VWIEN="" D
.. S STVW=VWIEN
.. ; if the field has been inactivated, don't get data
.. I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
.. S KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
.. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
.. ; For a standard display, display the 'R'equired and 'D'efault fields
.. I $$GET1^DIQ(90506.1,STVW_",",3.04,"I")'="O" D
... D GVAL
... S VALUE=VALUE_VAL_"^"
... S HEADR=HEADR_HDR_"^"
... K VAL,HDR
;
Q
;
GVAL ; Get values
;Parameters
; FIL = FileMan file number
; FLD = FileMan field number
; EXEC = If an executable is needed to determine value
; HDR = Header value
;the executable expects the value to be returned in variable VAL
NEW FIL,FLD,EXEC
S VAL=""
S FIL=$$GET1^DIQ(90506.1,STVW_",",.05,"E")
S FLD=$$GET1^DIQ(90506.1,STVW_",",.06,"E")
S EXEC=$$GET1^DIQ(90506.1,STVW_",",1,"E")
S HDR=$$GET1^DIQ(90506.1,STVW_",",.08,"E")
I $G(DFN)="" S VAL="" Q
;
I $G(EXEC)'="" X EXEC Q
;
I FIL'="",FLD'="" S VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
Q
;
PAT(DATA,OWNR,PLIEN,PLIST) ; EP -- BQI GET PATIENT LIST BY DFN
; Get a single patient list record
NEW UID,II,X
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPLVWP",UID))
K @DATA
S II=0,PLIST=$G(PLIST,"")
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLVWP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
D HDR^BQIPLPT
;
I PLIST="" 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 EN(.DATA,OWNR,PLIEN,.DFN)
S II=II+1,@DATA@(II)=$C(31)
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
BQIPLVWP ;PRXM/HC/ALA-Get Patient Data by View ; 17 Oct 2005 4:49 PM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
+3 QUIT
+4 ;
EN(DATA,OWNR,PLIEN,DFN) ;EP - Starting point
+1 ;
+2 ;Description
+3 ; Builds the header and data string in the panel
+4 ; display order. If a customized view exists, it
+5 ; builds it, otherwise it builds the standard.
+6 ;Input
+7 ; OWNR - owner of the panel
+8 ; PLIEN - panel internal entry number
+9 ; PLIST - List of patient IENs separated by $C(28)
+10 ; DATA - Global reference
+11 ;Expects
+12 ; DUZ - person signed onto system
+13 ; II - counter variable
+14 ;
+15 ; if the user is the owner of the panel, use the owner's display order
+16 NEW BQI,CTYP,SRC,HEADR,VALUE,QFL,KEY,VCODE
+17 SET CTYP="D"
SET SRC=$ORDER(^BQI(90506.5,"C",CTYP,""))
+18 SET HEADR="I00010DFN^T00001TICKLER_INDICATOR^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^"
SET VALUE=""
+19 IF $GET(DFN)'=""
SET VALUE=DFN_U_$$FLG^BTPWPPAT(DFN)_U_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_U_$$SENS^BQIULPT(DFN)_U_$$CALR^BQIULPT(DFN)_U_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_U
+20 ; Check for template
+21 NEW DA,IENS,TEMPL,LYIEN,VWIEN
+22 SET TEMPL=""
+23 IF OWNR'=DUZ
Begin DoDot:1
+24 SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,"C",CTYP,""))
+25 IF DA=""
QUIT
+26 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET IENS=$$IENS^DILF(.DA)
+27 SET TEMPL=$$GET1^DIQ(90505.34,IENS,.01,"E")
End DoDot:1
+28 IF OWNR=DUZ
Begin DoDot:1
+29 SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,4,"C",CTYP,""))
+30 IF DA=""
QUIT
+31 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET IENS=$$IENS^DILF(.DA)
+32 SET TEMPL=$$GET1^DIQ(90505.14,IENS,.01,"E")
End DoDot:1
+33 ;
+34 ; If template, use it
+35 IF TEMPL'=""
SET TQFL=0
Begin DoDot:1
+36 SET LYIEN=$$TPN^BQILYUTL(DUZ,TEMPL)
+37 IF LYIEN=""
SET TQFL=1
QUIT
+38 SET DOR=""
+39 FOR
SET DOR=$ORDER(^BQICARE(DUZ,15,LYIEN,1,"C",DOR))
IF DOR=""
QUIT
Begin DoDot:2
+40 SET VWIEN=""
+41 FOR
SET VWIEN=$ORDER(^BQICARE(DUZ,15,LYIEN,1,"C",DOR,VWIEN))
IF VWIEN=""
QUIT
Begin DoDot:3
+42 SET VCODE=$PIECE(^BQICARE(DUZ,15,LYIEN,1,VWIEN,0),U,1)
+43 SET GIEN=$ORDER(^BQI(90506.1,"B",VCODE,""))
IF GIEN=""
QUIT
+44 SET KEY=$$GET1^DIQ(90506.1,GIEN_",",3.1,"E")
+45 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+46 SET STVW=GIEN
+47 ; if the field has been inactivated, don't get data
+48 IF $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1
QUIT
+49 DO GVAL
+50 SET VALUE=VALUE_VAL_"^"
+51 SET HEADR=HEADR_HDR_"^"
+52 KILL VAL,HDR
End DoDot:3
End DoDot:2
End DoDot:1
IF 'TQFL
GOTO FIN
+53 ;
+54 ; If no template, check for customized
+55 ;
+56 IF OWNR=DUZ
Begin DoDot:1
+57 SET VWIEN=0
SET CIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,20,VWIEN))
+58 IF CIEN'=""
Begin DoDot:2
+59 FOR
SET VWIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,20,VWIEN))
IF 'VWIEN
QUIT
Begin DoDot:3
+60 NEW DA,IENS,STVW
+61 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=VWIEN
SET IENS=$$IENS^DILF(.DA)
+62 SET VCODE=$$GET1^DIQ(90505.05,IENS,.01,"I")
+63 SET STVW=$ORDER(^BQI(90506.1,"B",VCODE,""))
IF STVW=""
QUIT
+64 ; if the field has been inactivated, don't get data
+65 IF $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1
QUIT
+66 ; if the source does not match, quit
+67 IF $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC
QUIT
+68 SET KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
+69 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+70 DO GVAL
+71 SET VALUE=VALUE_VAL_"^"
+72 SET HEADR=HEADR_HDR_"^"
+73 KILL VAL,HDR
End DoDot:3
End DoDot:2
QUIT
+74 ;
+75 ; If no customized found, use default
+76 IF CIEN=""
DO STAND()
End DoDot:1
+77 ;
+78 IF OWNR'=DUZ
Begin DoDot:1
+79 SET VWIEN=0
SET CIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,VWIEN))
+80 IF CIEN'=""
Begin DoDot:2
+81 FOR
SET VWIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,VWIEN))
IF 'VWIEN
QUIT
Begin DoDot:3
+82 NEW DA,IENS,STVW
+83 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET DA=VWIEN
+84 SET IENS=$$IENS^DILF(.DA)
+85 SET VCODE=$$GET1^DIQ(90505.06,IENS,.01,"I")
+86 SET STVW=$ORDER(^BQI(90506.1,"B",VCODE,""))
IF STVW=""
QUIT
+87 ; if the field has been inactivated, don't get data
+88 IF $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1
QUIT
+89 ; if the source does not match, quit
+90 IF $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC
QUIT
+91 SET KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
+92 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+93 DO GVAL
+94 SET VALUE=VALUE_VAL_"^"
+95 SET HEADR=HEADR_HDR_"^"
+96 KILL VAL,HDR
End DoDot:3
End DoDot:2
QUIT
+97 ;
+98 ; If no customized found, use default
+99 IF CIEN=""
DO STAND()
End DoDot:1
+100 ;
FIN ; Finish
+1 ; remove trailing up-arrows
+2 SET HEADR=$$TKO^BQIUL1(HEADR,"^")
+3 SET VALUE=$$TKO^BQIUL1(VALUE,"^")
+4 IF DFN=""
SET VALUE=""
+5 ;
+6 IF II=0
SET @DATA@(II)=HEADR_$CHAR(30)
+7 IF VALUE'=""
SET II=II+1
SET @DATA@(II)=VALUE_$CHAR(30)
KILL VALUE
+8 KILL HEADR
+9 QUIT
+10 ;
STAND() ;EP - Get standard display
+1 NEW VWIEN,HDR,SENS
+2 SET HEADR="I00010DFN^T00001TICKLER_INDICATOR^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^"
SET VALUE=""
+3 IF $GET(DFN)'=""
SET VALUE=DFN_U_$$FLG^BTPWPPAT(DFN)_U_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_U_$$SENS^BQIULPT(DFN)_U_$$CALR^BQIULPT(DFN)_U_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_U
+4 ;
+5 SET ORD=""
+6 FOR
SET ORD=$ORDER(^BQI(90506.1,"AD","D",ORD))
IF ORD=""
QUIT
Begin DoDot:1
+7 SET VWIEN=""
+8 FOR
SET VWIEN=$ORDER(^BQI(90506.1,"AD","D",ORD,VWIEN))
IF VWIEN=""
QUIT
Begin DoDot:2
+9 SET STVW=VWIEN
+10 ; if the field has been inactivated, don't get data
+11 IF $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1
QUIT
+12 SET KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
+13 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+14 ; For a standard display, display the 'R'equired and 'D'efault fields
+15 IF $$GET1^DIQ(90506.1,STVW_",",3.04,"I")'="O"
Begin DoDot:3
+16 DO GVAL
+17 SET VALUE=VALUE_VAL_"^"
+18 SET HEADR=HEADR_HDR_"^"
+19 KILL VAL,HDR
End DoDot:3
End DoDot:2
End DoDot:1
+20 ;
+21 QUIT
+22 ;
GVAL ; Get values
+1 ;Parameters
+2 ; FIL = FileMan file number
+3 ; FLD = FileMan field number
+4 ; EXEC = If an executable is needed to determine value
+5 ; HDR = Header value
+6 ;the executable expects the value to be returned in variable VAL
+7 NEW FIL,FLD,EXEC
+8 SET VAL=""
+9 SET FIL=$$GET1^DIQ(90506.1,STVW_",",.05,"E")
+10 SET FLD=$$GET1^DIQ(90506.1,STVW_",",.06,"E")
+11 SET EXEC=$$GET1^DIQ(90506.1,STVW_",",1,"E")
+12 SET HDR=$$GET1^DIQ(90506.1,STVW_",",.08,"E")
+13 IF $GET(DFN)=""
SET VAL=""
QUIT
+14 ;
+15 IF $GET(EXEC)'=""
XECUTE EXEC
QUIT
+16 ;
+17 IF FIL'=""
IF FLD'=""
SET VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
+18 QUIT
+19 ;
PAT(DATA,OWNR,PLIEN,PLIST) ; EP -- BQI GET PATIENT LIST BY DFN
+1 ; Get a single patient list record
+2 NEW UID,II,X
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQIPLVWP",UID))
+5 KILL @DATA
+6 SET II=0
SET PLIST=$GET(PLIST,"")
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPLVWP D UNWIND^%ZTER"
+8 ;
+9 DO HDR^BQIPLPT
+10 ;
+11 IF PLIST=""
Begin DoDot:1
+12 SET LIST=""
SET BN=""
+13 FOR
SET BN=$ORDER(PLIST(BN))
IF BN=""
QUIT
SET LIST=LIST_PLIST(BN)
+14 KILL PLIST
SET PLIST=LIST
End DoDot:1
+15 ;
+16 FOR BQI=1:1
SET DFN=$PIECE(PLIST,$CHAR(28),BQI)
IF DFN=""
QUIT
Begin DoDot:1
+17 ;I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q
+18 DO EN(.DATA,OWNR,PLIEN,.DFN)
End DoDot:1
+19 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+20 QUIT
+21 ;
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
