BQIRGASP ;VNGT/HS/ALA-Asthma Patient ; 06 Mar 2009 3:58 PM
;;2.5;ICARE MANAGEMENT SYSTEM;**1,2**;May 24, 2016;Build 14
;
;
EN(DATA,DFN,SOURCE) ;EP - BQI REFRESH PATIENT CARE MGT
; Input
; DFN - Patient internal entry number
; SOURCE - The Care Managment Source Type (full name e.g. Asthma)
;
NEW UID,II,BQDFN,SRCN,SRC,RESULT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP(UID,"BQIRGASP"))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRMPAT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T00050MSG"_$C(30)
S BQDFN=$G(DFN,""),SOURCE=$G(SOURCE,"")
I BQDFN="" S RESULT=-1_U_"No patient selected" G DONE
;
I SOURCE'="" D G DONE
. S SRCN=$O(^BQI(90506.5,"B",SOURCE,"")) I SRCN="" S RESULT=-1_U_SOURCE_" not found" Q
. S SRC=$P(^BQI(90506.5,SRCN,0),U,2)
. D PAT(BQDFN,SRC)
. S RESULT=1_U
;
I SOURCE="" D G DONE
. K ^BQIPAT(DFN,60)
. ; If flag is set for nightly/weekly
. S SRIEN=""
. F S SRIEN=$O(^BQI(90506.5,"AD",1,SRIEN)) Q:SRIEN="" D
.. I $P($G(^BQI(90506.5,SRIEN,0)),"^",10)=1 Q
.. ;I $P($G(^BQI(90506.5,SRIEN,0)),"^",16)'=1 Q
.. S SOURCE=$P($G(^BQI(90506.5,SRIEN,0)),"^",1)
.. S SRC=$P($G(^BQI(90506.5,SRIEN,0)),U,2)
.. D PAT(BQDFN,SRC)
.. S RESULT=1_U
;
DONE ;
S II=II+1,@DATA@(II)=RESULT_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
PAT(BQDFN,SRC) ;EP - Get all Care Mgmt data for a patient
;
NEW DA,IENS,DIC,PSRIEN,SRIEN,CDRIEN,X,Y,CODE,DLAYGO,DIC,HDR,IEN,ORD,V
NEW BQIUPD,VALUE,VISIT,OTHER,STVW,VAL,VSDTM,CT,ASN,%ANS,APCHSBWR,R,T,W
NEW APCHSDAT,APCHSTEX,APCHSTXN,LPAP,%1,%ANS,%DT,%X,%Y,AIEN,AMQQTAXN,LT,M
NEW APCHC,APCHCPT,APCHLAST,APCHRF,BD,C,D,D0,DAT1,DAT2,DATE,E,ED,G,H,J
S SRIEN=$O(^BQI(90506.5,"C",SRC,"")) I SRIEN="" Q
; Check for bad records
I $O(^BQIPAT(BQDFN,60,"B",SRIEN,""))="" D
. S ASN=0
. F S ASN=$O(^BQIPAT(BQDFN,60,ASN)) Q:'ASN D
.. I $G(^BQIPAT(BQDFN,60,ASN,0))'="",$P($G(^BQIPAT(BQDFN,60,ASN,0)),U,1)'=SRIEN Q
.. I $G(^BQIPAT(BQDFN,60,ASN,0))'="",$P($G(^BQIPAT(BQDFN,60,ASN,0)),U,1)=SRIEN Q
.. K ^BQIPAT(BQDFN,60,ASN)
;
S DA(1)=BQDFN,X=$P(^BQI(90506.5,SRIEN,0),U,1),DIC(0)="L",DLAYGO=90507.56
S DIC="^BQIPAT("_DA(1)_",60,"
I $G(^BQIPAT(BQDFN,60,0))="" S ^BQIPAT(BQDFN,60,0)="^90507.56P^^"
D ^DIC
S (PSRIEN,DA)=+Y
S IENS=$$IENS^DILF(.DA)
S BQIUPD(90507.56,IENS,.02)=$$NOW^XLFDT()
;
I $G(SRC)="DM" D
. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J),BDMJOB=UID,BDMBTH=$H
. S CYR=$P($G(^BQI(90508,1,"DM")),U,1),BDMDMRG=$P($G(^BQI(90508,1,"DM")),"^",2)
. S CIEN=$O(^BQI(90508,1,21,"B",CYR,"")) I CIEN="" Q
. S PGTHR=$P(^BQI(90508,1,21,CIEN,0),U,2),PGRF=$P(^(0),U,4)
. K ^XTMP(PGRF,BDMJOB) S ^XTMP(PGRF,0)=$$FMADD^XLFDT(DT,1)_"^"_DT_"^iCare DM AUDIT"
. S BDMRBD=DT,BDMADAT=DT,BDMTYPE="P",BDMRED=$$FMADD^XLFDT(BDMADAT,-365)
. S BDMBDAT=$$FMADD^XLFDT(BDMADAT,-365),BDMPD=DFN
. D @("GATHER^"_PGTHR)
;
; Check for Alternate display order first
S ORD=""
F S ORD=$O(^BQI(90506.1,"AF",SRC,ORD)) Q:ORD="" D
. S AIEN=""
. F S AIEN=$O(^BQI(90506.1,"AF",SRC,ORD,AIEN)) Q:AIEN="" D UPD(AIEN)
;
; Check for normal display order
S ORD=""
F S ORD=$O(^BQI(90506.1,"AD",SRC,ORD)) Q:ORD="" D
. S AIEN=""
. F S AIEN=$O(^BQI(90506.1,"AD",SRC,ORD,AIEN)) Q:AIEN="" D UPD(AIEN)
;
; Check for site-populated fields
S AIEN=0 F S AIEN=$O(^BQI(90506.5,SRIEN,10,AIEN)) Q:'AIEN D
. S EXEC=$G(^BQI(90506.5,SRIEN,10,AIEN,3)) I EXEC="" Q
. X EXEC
. S CODE=$P(^BQI(90506.5,SRIEN,10,AIEN,0),"^",1)
. D FILD
Q
;
UPD(AIEN) ; EP - Update values
;I $$GET1^DIQ(90506.1,AIEN_",",.1,"I")=1 Q
I $P($G(^BQI(90506.1,AIEN,0)),"^",10)=1 Q
S STVW=AIEN,VAL="",VISIT="",OTHER=""
D CVAL(BQDFN)
S CODE=$P($G(^BQI(90506.1,AIEN,0)),U,1) I CODE="" Q
I VAL'="" D
. I CODE="DM_TOBUSE" S VAL=$P(VAL,U,2)
. I CODE="DM_A1C" S VAL=$P(VAL,U,2)_" ("_$$FMTMDY^BQIUL1($P(VAL,U,1))_")"
. I CODE="DM_CREAT"!(CODE="DM_TCHOL")!(CODE="DM_HDL")!(CODE="DM_LDL")!(CODE="DM_TRIG") S VAL=$P(VAL,U,1)_"("_$P(VAL,U,2)_")"
. I CODE="DM_EGFR"!(CODE="DM_UACR") S VAL=$P(VAL,U,2)_" ("_$P(VAL,U,3)_")"
. I CODE="DM_TBTEST" S VAL=$P(VAL,"|",1)
. I CODE="DM_TBRES" S VAL=$P(VAL,"|",3)
;
I VAL="",CODE="DM_DMTYP" D
. D CURR
. D @("TYPEDM^"_PGTHR) I BDMTYDM'="" S VAL=BDMTYDM
D FILD
Q
;
FILD ;EP - File the data
S DA(2)=BQDFN,DA(1)=PSRIEN,X=CODE,DIC(0)="L",DLAYGO=90507.561
S DIC="^BQIPAT("_DA(2)_",60,"_DA(1)_",1,"
I $G(^BQIPAT(BQDFN,60,PSRIEN,1,0))="" S ^BQIPAT(BQDFN,60,PSRIEN,1,0)="^90507.561^^"
D ^DIC I +Y=-1 K DD,DO D FILE^DICN
S (CDRIEN,DA)=+Y
S IENS=$$IENS^DILF(.DA)
S BQIUPD(90507.561,IENS,.02)=$G(VAL)
S BQIUPD(90507.561,IENS,.03)=$G(DATE)
S BQIUPD(90507.561,IENS,.04)=$G(VISIT)
S BQIUPD(90507.561,IENS,.05)=$G(OTHER)
K VAL,OTHER,DATE,VISIT
I $D(BQIUPD)>0 D FILE^DIE("","BQIUPD","ERROR")
Q
;
CVAL(DFN) ; 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,RCODE,RGIEN,RIEN,RHDR,MVALUE,CODE
S FIL=$P($G(^BQI(90506.1,STVW,0)),"^",5)
S FLD=$P($G(^BQI(90506.1,STVW,0)),"^",6)
S EXEC=$G(^BQI(90506.1,STVW,5))
S HDR=$P($G(^BQI(90506.1,STVW,0)),"^",8)
I $G(DFN)="" S VAL="" Q
;
I $G(EXEC)'="" X EXEC Q
;
I FIL'="",FLD'="" S VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
Q
;
S RCODE=$$GET1^DIQ(90506.1,STVW_",",.01,"E")
S RGIEN=$O(^BQI(90506.3,"AC",CRIEN,"")),VAL=""
I RGIEN'="" D Q:VAL'=""
. S RIEN=$O(^BQI(90506.3,RGIEN,10,"AC",RCODE,""))
. I RIEN'="",$P($G(^BQI(90506.3,RGIEN,10,RIEN,1)),U,1)="M" D Q
.. S RHDR=$P(^BQI(90506.3,RGIEN,10,RIEN,0),U,2),MVALUE=""
.. NEW SNAME,SRIEN,SORD,SXREF,SIEN
.. S SNAME=$P(^BQI(90506.3,RGIEN,10,RIEN,0),U,1)
.. S SRIEN=$O(^BQI(90506.3,"B",SNAME,"")) I SRIEN="" Q
.. S SORD="",SXREF=$S($D(^BQI(90506.3,SRIEN,10,"AF")):"AF",1:"C")
.. F S SORD=$O(^BQI(90506.3,SRIEN,10,SXREF,SORD)) Q:SORD="" D
... S SIEN=""
... F S SIEN=$O(^BQI(90506.3,SRIEN,10,SXREF,SORD,SIEN)) Q:SIEN="" D
.... I $P(^BQI(90506.3,SRIEN,10,SIEN,0),U,4)'="S" Q
.... S CODE=$P(^BQI(90506.3,SRIEN,10,SIEN,0),U,7) I CODE="" Q
.... S STVW=$O(^BQI(90506.1,"B",CODE,"")) I STVW="" Q
.... I $P($G(^BQI(90506.1,STVW,0)),"^",10)=1 Q
.... NEW FIL,FLD,EXEC
.... S FIL=$P($G(^BQI(90506.1,STVW,0)),"^",5)
.... S FLD=$P($G(^BQI(90506.1,STVW,0)),"^",6)
.... S EXEC=$G(^BQI(90506.1,STVW,1))
.... S HDR=RHDR
.... I $G(DFN)="" S VAL="" Q
.... ;
.... I $G(EXEC)'="" X EXEC S VAL=VAL_$S(VAL'="":$C(10),1:"") Q
.... I FIL'="",FLD'="" S VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
.... S VALUE=VALUE_VAL_$S(VAL'="":$C(10),1:"")
.... S VAL=VALUE
... S MVALUE=MVALUE_$$TKO^BQIUL1(VAL,$C(10))
.. S VAL=MVALUE
Q
;
CURR ;EP - Get current DM Audit information
S CYR=$P($G(^BQI(90508,1,"DM")),U,1)
S CIEN=$O(^BQI(90508,1,21,"B",CYR,"")) I CIEN="" Q
S PGTHR=$P(^BQI(90508,1,21,CIEN,0),U,2),PGRF=$P(^(0),U,4)
Q
BQIRGASP ;VNGT/HS/ALA-Asthma Patient ; 06 Mar 2009 3:58 PM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1,2**;May 24, 2016;Build 14
+2 ;
+3 ;
EN(DATA,DFN,SOURCE) ;EP - BQI REFRESH PATIENT CARE MGT
+1 ; Input
+2 ; DFN - Patient internal entry number
+3 ; SOURCE - The Care Managment Source Type (full name e.g. Asthma)
+4 ;
+5 NEW UID,II,BQDFN,SRCN,SRC,RESULT
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP(UID,"BQIRGASP"))
+8 KILL @DATA
+9 ;
+10 SET II=0
+11 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRMPAT D UNWIND^%ZTER"
+12 SET @DATA@(II)="I00010RESULT^T00050MSG"_$CHAR(30)
+13 SET BQDFN=$GET(DFN,"")
SET SOURCE=$GET(SOURCE,"")
+14 IF BQDFN=""
SET RESULT=-1_U_"No patient selected"
GOTO DONE
+15 ;
+16 IF SOURCE'=""
Begin DoDot:1
+17 SET SRCN=$ORDER(^BQI(90506.5,"B",SOURCE,""))
IF SRCN=""
SET RESULT=-1_U_SOURCE_" not found"
QUIT
+18 SET SRC=$PIECE(^BQI(90506.5,SRCN,0),U,2)
+19 DO PAT(BQDFN,SRC)
+20 SET RESULT=1_U
End DoDot:1
GOTO DONE
+21 ;
+22 IF SOURCE=""
Begin DoDot:1
+23 KILL ^BQIPAT(DFN,60)
+24 ; If flag is set for nightly/weekly
+25 SET SRIEN=""
+26 FOR
SET SRIEN=$ORDER(^BQI(90506.5,"AD",1,SRIEN))
IF SRIEN=""
QUIT
Begin DoDot:2
+27 IF $PIECE($GET(^BQI(90506.5,SRIEN,0)),"^",10)=1
QUIT
+28 ;I $P($G(^BQI(90506.5,SRIEN,0)),"^",16)'=1 Q
+29 SET SOURCE=$PIECE($GET(^BQI(90506.5,SRIEN,0)),"^",1)
+30 SET SRC=$PIECE($GET(^BQI(90506.5,SRIEN,0)),U,2)
+31 DO PAT(BQDFN,SRC)
+32 SET RESULT=1_U
End DoDot:2
End DoDot:1
GOTO DONE
+33 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
+2 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+3 QUIT
+4 ;
PAT(BQDFN,SRC) ;EP - Get all Care Mgmt data for a patient
+1 ;
+2 NEW DA,IENS,DIC,PSRIEN,SRIEN,CDRIEN,X,Y,CODE,DLAYGO,DIC,HDR,IEN,ORD,V
+3 NEW BQIUPD,VALUE,VISIT,OTHER,STVW,VAL,VSDTM,CT,ASN,%ANS,APCHSBWR,R,T,W
+4 NEW APCHSDAT,APCHSTEX,APCHSTXN,LPAP,%1,%ANS,%DT,%X,%Y,AIEN,AMQQTAXN,LT,M
+5 NEW APCHC,APCHCPT,APCHLAST,APCHRF,BD,C,D,D0,DAT1,DAT2,DATE,E,ED,G,H,J
+6 SET SRIEN=$ORDER(^BQI(90506.5,"C",SRC,""))
IF SRIEN=""
QUIT
+7 ; Check for bad records
+8 IF $ORDER(^BQIPAT(BQDFN,60,"B",SRIEN,""))=""
Begin DoDot:1
+9 SET ASN=0
+10 FOR
SET ASN=$ORDER(^BQIPAT(BQDFN,60,ASN))
IF 'ASN
QUIT
Begin DoDot:2
+11 IF $GET(^BQIPAT(BQDFN,60,ASN,0))'=""
IF $PIECE($GET(^BQIPAT(BQDFN,60,ASN,0)),U,1)'=SRIEN
QUIT
+12 IF $GET(^BQIPAT(BQDFN,60,ASN,0))'=""
IF $PIECE($GET(^BQIPAT(BQDFN,60,ASN,0)),U,1)=SRIEN
QUIT
+13 KILL ^BQIPAT(BQDFN,60,ASN)
End DoDot:2
End DoDot:1
+14 ;
+15 SET DA(1)=BQDFN
SET X=$PIECE(^BQI(90506.5,SRIEN,0),U,1)
SET DIC(0)="L"
SET DLAYGO=90507.56
+16 SET DIC="^BQIPAT("_DA(1)_",60,"
+17 IF $GET(^BQIPAT(BQDFN,60,0))=""
SET ^BQIPAT(BQDFN,60,0)="^90507.56P^^"
+18 DO ^DIC
+19 SET (PSRIEN,DA)=+Y
+20 SET IENS=$$IENS^DILF(.DA)
+21 SET BQIUPD(90507.56,IENS,.02)=$$NOW^XLFDT()
+22 ;
+23 IF $GET(SRC)="DM"
Begin DoDot:1
+24 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
SET BDMJOB=UID
SET BDMBTH=$HOROLOG
+25 SET CYR=$PIECE($GET(^BQI(90508,1,"DM")),U,1)
SET BDMDMRG=$PIECE($GET(^BQI(90508,1,"DM")),"^",2)
+26 SET CIEN=$ORDER(^BQI(90508,1,21,"B",CYR,""))
IF CIEN=""
QUIT
+27 SET PGTHR=$PIECE(^BQI(90508,1,21,CIEN,0),U,2)
SET PGRF=$PIECE(^(0),U,4)
+28 KILL ^XTMP(PGRF,BDMJOB)
SET ^XTMP(PGRF,0)=$$FMADD^XLFDT(DT,1)_"^"_DT_"^iCare DM AUDIT"
+29 SET BDMRBD=DT
SET BDMADAT=DT
SET BDMTYPE="P"
SET BDMRED=$$FMADD^XLFDT(BDMADAT,-365)
+30 SET BDMBDAT=$$FMADD^XLFDT(BDMADAT,-365)
SET BDMPD=DFN
+31 DO @("GATHER^"_PGTHR)
End DoDot:1
+32 ;
+33 ; Check for Alternate display order first
+34 SET ORD=""
+35 FOR
SET ORD=$ORDER(^BQI(90506.1,"AF",SRC,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+36 SET AIEN=""
+37 FOR
SET AIEN=$ORDER(^BQI(90506.1,"AF",SRC,ORD,AIEN))
IF AIEN=""
QUIT
DO UPD(AIEN)
End DoDot:1
+38 ;
+39 ; Check for normal display order
+40 SET ORD=""
+41 FOR
SET ORD=$ORDER(^BQI(90506.1,"AD",SRC,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+42 SET AIEN=""
+43 FOR
SET AIEN=$ORDER(^BQI(90506.1,"AD",SRC,ORD,AIEN))
IF AIEN=""
QUIT
DO UPD(AIEN)
End DoDot:1
+44 ;
+45 ; Check for site-populated fields
+46 SET AIEN=0
FOR
SET AIEN=$ORDER(^BQI(90506.5,SRIEN,10,AIEN))
IF 'AIEN
QUIT
Begin DoDot:1
+47 SET EXEC=$GET(^BQI(90506.5,SRIEN,10,AIEN,3))
IF EXEC=""
QUIT
+48 XECUTE EXEC
+49 SET CODE=$PIECE(^BQI(90506.5,SRIEN,10,AIEN,0),"^",1)
+50 DO FILD
End DoDot:1
+51 QUIT
+52 ;
UPD(AIEN) ; EP - Update values
+1 ;I $$GET1^DIQ(90506.1,AIEN_",",.1,"I")=1 Q
+2 IF $PIECE($GET(^BQI(90506.1,AIEN,0)),"^",10)=1
QUIT
+3 SET STVW=AIEN
SET VAL=""
SET VISIT=""
SET OTHER=""
+4 DO CVAL(BQDFN)
+5 SET CODE=$PIECE($GET(^BQI(90506.1,AIEN,0)),U,1)
IF CODE=""
QUIT
+6 IF VAL'=""
Begin DoDot:1
+7 IF CODE="DM_TOBUSE"
SET VAL=$PIECE(VAL,U,2)
+8 IF CODE="DM_A1C"
SET VAL=$PIECE(VAL,U,2)_" ("_$$FMTMDY^BQIUL1($PIECE(VAL,U,1))_")"
+9 IF CODE="DM_CREAT"!(CODE="DM_TCHOL")!(CODE="DM_HDL")!(CODE="DM_LDL")!(CODE="DM_TRIG")
SET VAL=$PIECE(VAL,U,1)_"("_$PIECE(VAL,U,2)_")"
+10 IF CODE="DM_EGFR"!(CODE="DM_UACR")
SET VAL=$PIECE(VAL,U,2)_" ("_$PIECE(VAL,U,3)_")"
+11 IF CODE="DM_TBTEST"
SET VAL=$PIECE(VAL,"|",1)
+12 IF CODE="DM_TBRES"
SET VAL=$PIECE(VAL,"|",3)
End DoDot:1
+13 ;
+14 IF VAL=""
IF CODE="DM_DMTYP"
Begin DoDot:1
+15 DO CURR
+16 DO @("TYPEDM^"_PGTHR)
IF BDMTYDM'=""
SET VAL=BDMTYDM
End DoDot:1
+17 DO FILD
+18 QUIT
+19 ;
FILD ;EP - File the data
+1 SET DA(2)=BQDFN
SET DA(1)=PSRIEN
SET X=CODE
SET DIC(0)="L"
SET DLAYGO=90507.561
+2 SET DIC="^BQIPAT("_DA(2)_",60,"_DA(1)_",1,"
+3 IF $GET(^BQIPAT(BQDFN,60,PSRIEN,1,0))=""
SET ^BQIPAT(BQDFN,60,PSRIEN,1,0)="^90507.561^^"
+4 DO ^DIC
IF +Y=-1
KILL DD,DO
DO FILE^DICN
+5 SET (CDRIEN,DA)=+Y
+6 SET IENS=$$IENS^DILF(.DA)
+7 SET BQIUPD(90507.561,IENS,.02)=$GET(VAL)
+8 SET BQIUPD(90507.561,IENS,.03)=$GET(DATE)
+9 SET BQIUPD(90507.561,IENS,.04)=$GET(VISIT)
+10 SET BQIUPD(90507.561,IENS,.05)=$GET(OTHER)
+11 KILL VAL,OTHER,DATE,VISIT
+12 IF $DATA(BQIUPD)>0
DO FILE^DIE("","BQIUPD","ERROR")
+13 QUIT
+14 ;
CVAL(DFN) ; 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,RCODE,RGIEN,RIEN,RHDR,MVALUE,CODE
+8 SET FIL=$PIECE($GET(^BQI(90506.1,STVW,0)),"^",5)
+9 SET FLD=$PIECE($GET(^BQI(90506.1,STVW,0)),"^",6)
+10 SET EXEC=$GET(^BQI(90506.1,STVW,5))
+11 SET HDR=$PIECE($GET(^BQI(90506.1,STVW,0)),"^",8)
+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 ;
+19 SET RCODE=$$GET1^DIQ(90506.1,STVW_",",.01,"E")
+20 SET RGIEN=$ORDER(^BQI(90506.3,"AC",CRIEN,""))
SET VAL=""
+21 IF RGIEN'=""
Begin DoDot:1
+22 SET RIEN=$ORDER(^BQI(90506.3,RGIEN,10,"AC",RCODE,""))
+23 IF RIEN'=""
IF $PIECE($GET(^BQI(90506.3,RGIEN,10,RIEN,1)),U,1)="M"
Begin DoDot:2
+24 SET RHDR=$PIECE(^BQI(90506.3,RGIEN,10,RIEN,0),U,2)
SET MVALUE=""
+25 NEW SNAME,SRIEN,SORD,SXREF,SIEN
+26 SET SNAME=$PIECE(^BQI(90506.3,RGIEN,10,RIEN,0),U,1)
+27 SET SRIEN=$ORDER(^BQI(90506.3,"B",SNAME,""))
IF SRIEN=""
QUIT
+28 SET SORD=""
SET SXREF=$SELECT($DATA(^BQI(90506.3,SRIEN,10,"AF")):"AF",1:"C")
+29 FOR
SET SORD=$ORDER(^BQI(90506.3,SRIEN,10,SXREF,SORD))
IF SORD=""
QUIT
Begin DoDot:3
+30 SET SIEN=""
+31 FOR
SET SIEN=$ORDER(^BQI(90506.3,SRIEN,10,SXREF,SORD,SIEN))
IF SIEN=""
QUIT
Begin DoDot:4
+32 IF $PIECE(^BQI(90506.3,SRIEN,10,SIEN,0),U,4)'="S"
QUIT
+33 SET CODE=$PIECE(^BQI(90506.3,SRIEN,10,SIEN,0),U,7)
IF CODE=""
QUIT
+34 SET STVW=$ORDER(^BQI(90506.1,"B",CODE,""))
IF STVW=""
QUIT
+35 IF $PIECE($GET(^BQI(90506.1,STVW,0)),"^",10)=1
QUIT
+36 NEW FIL,FLD,EXEC
+37 SET FIL=$PIECE($GET(^BQI(90506.1,STVW,0)),"^",5)
+38 SET FLD=$PIECE($GET(^BQI(90506.1,STVW,0)),"^",6)
+39 SET EXEC=$GET(^BQI(90506.1,STVW,1))
+40 SET HDR=RHDR
+41 IF $GET(DFN)=""
SET VAL=""
QUIT
+42 ;
+43 IF $GET(EXEC)'=""
XECUTE EXEC
SET VAL=VAL_$SELECT(VAL'="":$CHAR(10),1:"")
QUIT
+44 IF FIL'=""
IF FLD'=""
SET VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
+45 SET VALUE=VALUE_VAL_$SELECT(VAL'="":$CHAR(10),1:"")
+46 SET VAL=VALUE
End DoDot:4
+47 SET MVALUE=MVALUE_$$TKO^BQIUL1(VAL,$CHAR(10))
End DoDot:3
+48 SET VAL=MVALUE
End DoDot:2
QUIT
End DoDot:1
IF VAL'=""
QUIT
+49 QUIT
+50 ;
CURR ;EP - Get current DM Audit information
+1 SET CYR=$PIECE($GET(^BQI(90508,1,"DM")),U,1)
+2 SET CIEN=$ORDER(^BQI(90508,1,21,"B",CYR,""))
IF CIEN=""
QUIT
+3 SET PGTHR=$PIECE(^BQI(90508,1,21,CIEN,0),U,2)
SET PGRF=$PIECE(^(0),U,4)
+4 QUIT
