BQIGPRA1 ;PRXM/HC/ALA - GPRA RPC Call continued ; 13 Jan 2006 10:35 AM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
PNL(DATA,OWNR,PLIEN,PLIST) ;EP - BQI GET GPRA RESULTS BY PANEL
;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
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIGPPNL",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIGPRA1 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
; get the current GPRA year for this panel
NEW DA,IENS,BQIYR,BQIH,BQIY,DFN,NAFLG
S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
S BQIYR=$$GET1^DIQ(90505.01,IENS,3.3,"E")
S BQIH=$$SPM^BQIGPUTL()
I BQIYR="" S BQIYR=$$GET1^DIQ(90508,BQIH_",",2,"E")
S BQIY=$$LKP^BQIGPUTL(BQIYR)
; get the global references for the corresponding CRS year
D GFN^BQIGPUTL(BQIH,BQIY)
;
; 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 ;
; If no data was found, generate the header
I II=0,'$D(@DATA) D STAND()
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
;
PAT(DATA,OWNR,PLIEN,DFN) ;EP - Build record by patient
NEW GMET,GHDR
; if the user is the owner of the panel, use the owner's display order
I $G(DUZ)=$G(OWNR),$O(^BQICARE(OWNR,1,PLIEN,25,0)) D COWN(OWNR,PLIEN,DFN) G EXIT
; if the user is a shared user, use the user's display order
I $G(DUZ)'=$G(OWNR),$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,25,0)) D NCDUZ(OWNR,PLIEN,DFN) G EXIT
; otherwise use the standard display order
D STAND()
;
EXIT ;
Q
;
COWN(OWNR,PLIEN,DFN) ;EP - Get customized display for an owner
;Parameters
; DFN = Patient internal entry number
; HEADR = Record header
; STVW = Panel view definition internal entry number
; VALUE = Record value
;
NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,VAL
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^D00030HIDE_DOB^"
S DORD=0
F S DORD=$O(^BQICARE(OWNR,1,PLIEN,25,"C",DORD)) Q:'DORD D
. S IEN=""
. F S IEN=$O(^BQICARE(OWNR,1,PLIEN,25,"C",DORD,IEN)) Q:'IEN D
.. NEW DA,IENS,STVW
.. S DA(2)=OWNR,DA(1)=PLIEN,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S STVW=$$GET1^DIQ(90505.125,IENS,.01,"E"),STVWCD=STVW
.. NEW SIEN
.. S SIEN=$O(^BQI(90506.1,"B",STVW,""))
.. ;NEW STVW
.. ;S STVW=SIEN
.. ;I $P(^BQI(90506.1,SIEN,2),U,1)="D" S STVW=SIEN D CVAL
.. I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient" S STVW=SIEN D CVAL
.. ;I $P(^BQI(90506.1,SIEN,2),U,1)="G" S STVW=STVWCD D GVAL
.. I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Performance" S STVW=STVWCD D GVAL
.. S VALUE=VALUE_VAL_"^"
.. S HEADR=HEADR_HDR_"^"
;
; 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
;
NCDUZ(OWNR,PLIEN,DFN) ;EP - Get customized display for a shared user
; New (in DEV) CDUZ
NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,VAL
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^D00030HIDE_DOB^"
S IEN=0
F S IEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,25,IEN)) Q:'IEN D
. NEW DA,IENS,STVW
. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,DA=IEN
. S IENS=$$IENS^DILF(.DA)
. S STVW=$$GET1^DIQ(90505.325,IENS,.01,"I"),STVWCD=STVW
. NEW SIEN
. S SIEN=$O(^BQI(90506.1,"B",STVW,""))
. ;I $P(^BQI(90506.1,SIEN,2),U,1)="D" S STVW=SIEN D CVAL
. I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient" S STVW=SIEN D CVAL
. ;I $P(^BQI(90506.1,SIEN,2),U,1)="G" S STVW=STVWCD D GVAL
. I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Performance" S STVW=STVWCD D GVAL
. S VALUE=VALUE_VAL_"^"
. S HEADR=HEADR_HDR_"^"
;
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
;
STAND() ;EP - Get standard display
NEW IEN,HDR,VALUE,HEADR,SENS,HDOB,Y,VER,VAL
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^D00030HIDE_DOB^"
S IEN=0
F S IEN=$O(^BQI(90506.1,"AC","D",IEN)) Q:IEN="" D
. S STVW=IEN
. ; For a standard display, only display the 'R'equired fields.
. I $$GET1^DIQ(90506.1,STVW_",",3.04,"I")'="O" D
.. D CVAL
.. S VALUE=VALUE_VAL_"^"
.. S HEADR=HEADR_HDR_"^"
;
I $G(BQIMEASF)="" D INP^BQINIGHT
S IEN=0
F S IEN=$O(^BQI(90506.1,"AC","G",IEN)) Q:IEN="" D
. S STVW=$P(^BQI(90506.1,IEN,0),U,1)
. I $P(STVW,"_",1)'=BQIYR Q
. I $P(^BQI(90506.1,IEN,0),U,10)=1 Q
. S GIEN=$P(STVW,"_",2)
. S VER=$$VERSION^XPDUTL("BGP")
. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
.. I VER<8.0 D
... S PGIEN=$O(^BQI(90508,BQIH,20,BQIY,20,"B",GIEN,"")) I PGIEN="" Q
... S NAFLG=+$P(^BQI(90508,BQIH,20,BQIY,20,PGIEN,0),U,4)
.. I VER>7.0 D
... S NAFLG=$$GET1^DIQ(BQIMEASF,GIEN_",",1704,"I")
... S NAFLG=$S(NAFLG="Y":1,1:0)
.. D GVAL
.. S VALUE=VALUE_VAL_"^"
.. S HEADR=HEADR_HDR_"^"
;
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
;
CVAL ; Get demographic 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 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
;
GVAL ;EP - Get GPRA value for patient
NEW PIEN,DEN,NUM,SPVW,SPIEN,VER,BQIDOD
I $G(BQIMEASF)="" D INP^BQINIGHT
I $G(DFN)="" S VAL="",HDR="T00003"_STVW,GMET="" Q
S BQIDOD=$$GET1^DIQ(2,DFN_",",.351,"I") ; Is patient deceased?
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
I VER<8.0 D
. S SPIEN=$O(^BQI(90508,BQIH,20,BQIY,20,"B",SPVW,"")) I SPIEN="" Q
. S NAFLG=+$P(^BQI(90508,BQIH,20,BQIY,20,SPIEN,0),"^",4)
;
I VER>7.0 D
. 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
BQIGPRA1 ;PRXM/HC/ALA - GPRA RPC Call continued ; 13 Jan 2006 10:35 AM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
PNL(DATA,OWNR,PLIEN,PLIST) ;EP - BQI GET GPRA RESULTS BY PANEL
+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
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET DATA=$NAME(^TMP("BQIGPPNL",UID))
+9 KILL @DATA
+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 GPRA year for this panel
+15 NEW DA,IENS,BQIYR,BQIH,BQIY,DFN,NAFLG
+16 SET DA(1)=OWNR
SET DA=PLIEN
SET IENS=$$IENS^DILF(.DA)
+17 SET BQIYR=$$GET1^DIQ(90505.01,IENS,3.3,"E")
+18 SET BQIH=$$SPM^BQIGPUTL()
+19 IF BQIYR=""
SET BQIYR=$$GET1^DIQ(90508,BQIH_",",2,"E")
+20 SET BQIY=$$LKP^BQIGPUTL(BQIYR)
+21 ; get the global references for the corresponding CRS year
+22 DO GFN^BQIGPUTL(BQIH,BQIY)
+23 ;
+24 ; If a list of DFNs, process them instead of entire panel
+25 IF $DATA(PLIST)>0
Begin DoDot:1
+26 IF $DATA(PLIST)>1
Begin DoDot:2
+27 SET LIST=""
SET BN=""
+28 FOR
SET BN=$ORDER(PLIST(BN))
IF BN=""
QUIT
SET LIST=LIST_PLIST(BN)
+29 KILL PLIST
SET PLIST=LIST
End DoDot:2
+30 FOR BQI=1:1
SET DFN=$PIECE(PLIST,$CHAR(28),BQI)
IF DFN=""
QUIT
Begin DoDot:2
+31 IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"
QUIT
+32 DO PAT(.DATA,OWNR,PLIEN,DFN)
End DoDot:2
End DoDot:1
GOTO DONE
+33 ;
+34 SET DFN=0
+35 IF $ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))=""
DO PAT(.DATA,OWNR,PLIEN,"")
GOTO DONE
+36 ;
+37 FOR
SET DFN=$ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+38 IF $PIECE($GET(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R"
QUIT
+39 DO PAT(.DATA,OWNR,PLIEN,DFN)
End DoDot:1
+40 ;
DONE ;
+1 ; If no data was found, generate the header
+2 IF II=0
IF '$DATA(@DATA)
DO STAND()
+3 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+4 QUIT
+5 ;
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 GMET,GHDR
+2 ; if the user is the owner of the panel, use the owner's display order
+3 IF $GET(DUZ)=$GET(OWNR)
IF $ORDER(^BQICARE(OWNR,1,PLIEN,25,0))
DO COWN(OWNR,PLIEN,DFN)
GOTO EXIT
+4 ; if the user is a shared user, use the user's display order
+5 IF $GET(DUZ)'=$GET(OWNR)
IF $ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,25,0))
DO NCDUZ(OWNR,PLIEN,DFN)
GOTO EXIT
+6 ; otherwise use the standard display order
+7 DO STAND()
+8 ;
EXIT ;
+1 QUIT
+2 ;
COWN(OWNR,PLIEN,DFN) ;EP - Get customized display for an owner
+1 ;Parameters
+2 ; DFN = Patient internal entry number
+3 ; HEADR = Record header
+4 ; STVW = Panel view definition internal entry number
+5 ; VALUE = Record value
+6 ;
+7 NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,VAL
+8 SET VALUE=""
+9 IF DFN'=""
SET Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I")
SET HDOB=$$FMTE^BQIUL1(Y)
+10 IF DFN'=""
SET VALUE=DFN_"^"_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_"^"_$$SENS^BQIULPT(DFN)_"^"_$$CALR^BQIULPT(DFN)_"^"_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_"^"_HDOB_"^"
+11 SET HEADR="I00010DFN^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030HIDE_DOB^"
+12 SET DORD=0
+13 FOR
SET DORD=$ORDER(^BQICARE(OWNR,1,PLIEN,25,"C",DORD))
IF 'DORD
QUIT
Begin DoDot:1
+14 SET IEN=""
+15 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,25,"C",DORD,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+16 NEW DA,IENS,STVW
+17 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+18 SET STVW=$$GET1^DIQ(90505.125,IENS,.01,"E")
SET STVWCD=STVW
+19 NEW SIEN
+20 SET SIEN=$ORDER(^BQI(90506.1,"B",STVW,""))
+21 ;NEW STVW
+22 ;S STVW=SIEN
+23 ;I $P(^BQI(90506.1,SIEN,2),U,1)="D" S STVW=SIEN D CVAL
+24 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient"
SET STVW=SIEN
DO CVAL
+25 ;I $P(^BQI(90506.1,SIEN,2),U,1)="G" S STVW=STVWCD D GVAL
+26 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Performance"
SET STVW=STVWCD
DO GVAL
+27 SET VALUE=VALUE_VAL_"^"
+28 SET HEADR=HEADR_HDR_"^"
End DoDot:2
End DoDot:1
+29 ;
+30 ; remove trailing up-arrows
+31 SET HEADR=$$TKO^BQIUL1(HEADR,"^")
+32 SET VALUE=$$TKO^BQIUL1(VALUE,"^")
+33 ;
+34 IF DFN=""
SET VALUE=""
+35 ;
+36 IF II=0
SET @DATA@(II)=HEADR_$CHAR(30)
+37 IF VALUE'=""
SET II=II+1
SET @DATA@(II)=VALUE_$CHAR(30)
+38 ;
+39 QUIT
+40 ;
NCDUZ(OWNR,PLIEN,DFN) ;EP - Get customized display for a shared user
+1 ; New (in DEV) CDUZ
+2 NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,VAL
+3 SET VALUE=""
+4 IF DFN'=""
SET Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I")
SET HDOB=$$FMTE^BQIUL1(Y)
+5 IF DFN'=""
SET VALUE=DFN_"^"_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_"^"_$$SENS^BQIULPT(DFN)_"^"_$$CALR^BQIULPT(DFN)_"^"_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_"^"_HDOB_"^"
+6 SET HEADR="I00010DFN^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030HIDE_DOB^"
+7 SET IEN=0
+8 FOR
SET IEN=$ORDER(^BQICARE(OWNR,1,PLIEN,30,DUZ,25,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+9 NEW DA,IENS,STVW
+10 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=DUZ
SET DA=IEN
+11 SET IENS=$$IENS^DILF(.DA)
+12 SET STVW=$$GET1^DIQ(90505.325,IENS,.01,"I")
SET STVWCD=STVW
+13 NEW SIEN
+14 SET SIEN=$ORDER(^BQI(90506.1,"B",STVW,""))
+15 ;I $P(^BQI(90506.1,SIEN,2),U,1)="D" S STVW=SIEN D CVAL
+16 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient"
SET STVW=SIEN
DO CVAL
+17 ;I $P(^BQI(90506.1,SIEN,2),U,1)="G" S STVW=STVWCD D GVAL
+18 IF $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Performance"
SET STVW=STVWCD
DO GVAL
+19 SET VALUE=VALUE_VAL_"^"
+20 SET HEADR=HEADR_HDR_"^"
End DoDot:1
+21 ;
+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 ;
STAND() ;EP - Get standard display
+1 NEW IEN,HDR,VALUE,HEADR,SENS,HDOB,Y,VER,VAL
+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^D00030HIDE_DOB^"
+6 SET IEN=0
+7 FOR
SET IEN=$ORDER(^BQI(90506.1,"AC","D",IEN))
IF IEN=""
QUIT
Begin DoDot:1
+8 SET STVW=IEN
+9 ; For a standard display, only display the 'R'equired fields.
+10 IF $$GET1^DIQ(90506.1,STVW_",",3.04,"I")'="O"
Begin DoDot:2
+11 DO CVAL
+12 SET VALUE=VALUE_VAL_"^"
+13 SET HEADR=HEADR_HDR_"^"
End DoDot:2
End DoDot:1
+14 ;
+15 IF $GET(BQIMEASF)=""
DO INP^BQINIGHT
+16 SET IEN=0
+17 FOR
SET IEN=$ORDER(^BQI(90506.1,"AC","G",IEN))
IF IEN=""
QUIT
Begin DoDot:1
+18 SET STVW=$PIECE(^BQI(90506.1,IEN,0),U,1)
+19 IF $PIECE(STVW,"_",1)'=BQIYR
QUIT
+20 IF $PIECE(^BQI(90506.1,IEN,0),U,10)=1
QUIT
+21 SET GIEN=$PIECE(STVW,"_",2)
+22 SET VER=$$VERSION^XPDUTL("BGP")
+23 IF $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O"
Begin DoDot:2
+24 IF VER<8.0
Begin DoDot:3
+25 SET PGIEN=$ORDER(^BQI(90508,BQIH,20,BQIY,20,"B",GIEN,""))
IF PGIEN=""
QUIT
+26 SET NAFLG=+$PIECE(^BQI(90508,BQIH,20,BQIY,20,PGIEN,0),U,4)
End DoDot:3
+27 IF VER>7.0
Begin DoDot:3
+28 SET NAFLG=$$GET1^DIQ(BQIMEASF,GIEN_",",1704,"I")
+29 SET NAFLG=$SELECT(NAFLG="Y":1,1:0)
End DoDot:3
+30 DO GVAL
+31 SET VALUE=VALUE_VAL_"^"
+32 SET HEADR=HEADR_HDR_"^"
End DoDot:2
End DoDot:1
+33 ;
+34 SET HEADR=$$TKO^BQIUL1(HEADR,"^")
+35 SET VALUE=$$TKO^BQIUL1(VALUE,"^")
+36 ;
+37 IF DFN=""
SET VALUE=""
+38 ;
+39 IF II=0
SET @DATA@(II)=HEADR_$CHAR(30)
+40 IF VALUE'=""
SET II=II+1
SET @DATA@(II)=VALUE_$CHAR(30)
+41 QUIT
+42 ;
CVAL ; Get demographic 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 FIL=$$GET1^DIQ(90506.1,STVW_",",.05,"E")
+9 SET FLD=$$GET1^DIQ(90506.1,STVW_",",.06,"E")
+10 SET EXEC=$$GET1^DIQ(90506.1,STVW_",",1,"E")
+11 SET HDR=$$GET1^DIQ(90506.1,STVW_",",.08,"E")
+12 IF $GET(DFN)=""
SET VAL=""
QUIT
+13 ;
+14 IF $GET(EXEC)'=""
XECUTE EXEC
QUIT
+15 ;
+16 IF FIL'=""
IF FLD'=""
SET VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
+17 QUIT
+18 ;
GVAL ;EP - Get GPRA value for patient
+1 NEW PIEN,DEN,NUM,SPVW,SPIEN,VER,BQIDOD
+2 IF $GET(BQIMEASF)=""
DO INP^BQINIGHT
+3 IF $GET(DFN)=""
SET VAL=""
SET HDR="T00003"_STVW
SET GMET=""
QUIT
+4 ; Is patient deceased?
SET BQIDOD=$$GET1^DIQ(2,DFN_",",.351,"I")
+5 SET PIEN=$ORDER(^BQIPAT(DFN,30,"B",STVW,""))
+6 IF PIEN=""
SET VAL=$SELECT(BQIDOD'="":"{D}",1:"NDA")
SET HDR="T00003"_STVW
SET GMET=""
QUIT
+7 ;
+8 IF $GET(BQIH)=""
SET BQIH=$$SPM^BQIGPUTL()
+9 IF $GET(BQIYR)=""
SET BQIYR=$$GET1^DIQ(90508,BQIH_",",2,"E")
+10 SET BQIY=$$LKP^BQIGPUTL(BQIYR)
+11 ;
+12 SET VER=$$VERSION^XPDUTL("BGP")
+13 SET SPVW=$PIECE(STVW,"_",2)
SET NAFLG=0
+14 IF VER<8.0
Begin DoDot:1
+15 SET SPIEN=$ORDER(^BQI(90508,BQIH,20,BQIY,20,"B",SPVW,""))
IF SPIEN=""
QUIT
+16 SET NAFLG=+$PIECE(^BQI(90508,BQIH,20,BQIY,20,SPIEN,0),"^",4)
End DoDot:1
+17 ;
+18 IF VER>7.0
Begin DoDot:1
+19 SET NAFLG=$$GET1^DIQ(BQIMEASF,SPVW_",",1704,"I")
+20 SET NAFLG=$SELECT(NAFLG="Y":1,1:0)
End DoDot:1
+21 ;
+22 SET DEN=$PIECE(^BQIPAT(DFN,30,PIEN,0),U,4)
+23 SET NUM=+$PIECE(^BQIPAT(DFN,30,PIEN,0),U,3)
+24 ;
+25 IF DEN=""
Begin DoDot:1
+26 IF NAFLG'=1
SET VAL="N/A"
QUIT
+27 IF 'NUM
SET VAL=0
SET GMET=0
QUIT
+28 SET VAL=NUM
End DoDot:1
+29 IF DEN
Begin DoDot:1
+30 IF 'NUM
SET VAL="NO"
SET GMET=0
QUIT
+31 SET VAL="YES"
End DoDot:1
+32 SET HDR="T00003"_STVW
+33 IF BQIDOD'=""
SET VAL="{D}"
+34 QUIT
