BQIRGDMA ;VNGT/HS/ALA-Set up Diabetes Audit fields ; 17 Feb 2016 2:46 PM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
EN ;EP - Update Diabetes Audit when new one comes in
NEW PRVY,DMN,YR,NYRN,NYR,BQIGDA,BQIN1,BQIN2,DVY
S PRVY=$P($G(^BQI(90508,1,"DM")),U,1)
I PRVY'="" S NYR=PRVY+1
I PRVY="" S DVY=$P($$FMTE^XLFDT(DT,7),"/",1) D
. I '$D(^BDMDMTX("B",DVY)) S NYR=DVY-1 Q
. I $D(^BDMDMTX("B",DVY)) S NYR=DVY
;
S NYRN=$O(^BDMDMTX("B",NYR,"")) I NYRN="" Q
S BQIN1=$P(^BDMDMTX(NYRN,0),U,2),BQIN2=$P(^(0),U,3)
I PRVY'=NYR D
. S BQIDA=1
. NEW DA,IENS,DIC
. S DA(1)=BQIDA,X=NYR,DIC(0)="LMNZ",DIC="^BQI(90508,"_DA(1)_",21,"
. D ^DIC
. I +Y<1 Q
. S BQIGDA=+Y
. S DA=BQIGDA,IENS=$$IENS^DILF(.DA)
. S BQIUPD(90508.021,IENS,.02)=BQIN1
. S BQIUPD(90508.021,IENS,.03)=BQIN2
. S BQIUPD(90508.021,IENS,.04)="BDMDM"_$E(NYR,3,4)
. S BQIUPD(90508,BQIDA_",",21.01)=NYR
. D FILE^DIE("","BQIUPD","ERROR")
. D TAX(NYR)
. ;
. D AU
. ;
. D JBDM^BQITASK2
Q
;
AU ; Update Dm Audit in 90506.5
NEW BDMN,CODE,EXEC,IEN,BDMDATA,IEN,BQIUPD,TBDMN,TEXT
S IEN=""
F S IEN=$O(^BQI(90506.1,"AC","DM",IEN)) Q:IEN="" D
. S BQIUPD(90506.1,IEN_",",.1)=1
. I $P(^BQI(90506.1,IEN,0),U,11)="" S BQIUPD(90506.1,IEN_",",.11)=DT
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
;
S BDMN=0
F S BDMN=$O(^BDMDMTX(NYRN,11,BDMN)) Q:'BDMN D
. S BDMDATA=$G(^BDMDMTX(NYRN,11,BDMN,1)) I BDMDATA="" Q
. I $P(BDMDATA,U,4)="" Q
. S CODE="DM_"_$P(BDMDATA,U,4),EXEC=$TR($P(BDMDATA,U,3),"~","^")
. I CODE="DM_COMB",EXEC["COMBINEE" S EXEC="$$COMBINED^BDMDD1C(BDMPD)"
. I CODE="DM_HDL",EXEC["$$LDL" D
.. I NYR=2016 S EXEC="$$HDL^BDMDD18(BDMPD,BDMBDAT,BDMADAT)"
.. I NYR=2015 S EXEC="$$HDL^BDMDC18(BDMPD,BDMBDAT,BDMADAT)"
. S HDR="T00030"_CODE,NSOURCE="DM Audit",NCLIN="",NCAT=$P(BDMDATA,U,2)
. S ORD=$P(^BDMDMTX(NYRN,11,BDMN,0),"^",3)
. I ORD="" D
.. F I=1:1:12 S TEXT=$P($T(THER+I),";;",2) Q:TEXT="" D
... S TBDMN=$O(^BDMDMTX(NYRN,11,"B","DM THERAPY","")) I TBDMN="" S TBDMN=$O(^BDMDMTX(NYRN,11,"B","DIABETES THERAPY","")) I TBDMN="" Q
... I CODE=TEXT S ORD=$P(^BDMDMTX(NYRN,11,TBDMN,0),"^",3)
. S TEXT=$P(BDMDATA,U,1)
. I CODE="DM_TBTEST" S TEXT="TB Test Done"
. NEW DA,X,DIC,DLAYGO
. S DIC="^BQI(90506.1,",DIC(0)="L",X=CODE
. S DA=$O(^BQI(90506.1,"B",CODE,""))
. ;I DA'="" S ORD=$O(^BQI(90506.1,"AD","DM",""),-1)+1
. I DA="" D Q:$G(ERROR)=1
.. K DO,DD D FILE^DICN
.. S DA=+Y I DA=-1 S ERROR=1
.. ;S ORD=$O(^BQI(90506.1,"AD","DM",""),-1)+1
. S BQIUPD(90506.1,DA_",",.03)=TEXT
. S BQIUPD(90506.1,DA_",",.08)=HDR
. S BQIUPD(90506.1,DA_",",.15)=120
. S BQIUPD(90506.1,DA_",",.1)="@"
. S BQIUPD(90506.1,DA_",",.11)="@"
. D FILE^DIE("","BQIUPD","ERROR")
. ;
. S BQIUPD(90506.1,DA_",",3.01)=NSOURCE
. S BQIUPD(90506.1,DA_",",3.02)=NCLIN
. S BQIUPD(90506.1,DA_",",3.03)=NCAT
. S BQIUPD(90506.1,DA_",",3.04)="Default"
. S BQIUPD(90506.1,DA_",",3.05)=ORD
. S BQIUPD(90506.1,DA_",",1)="S VAL=$$DSP^BQIRGDMA(DFN,STVW)"
. ;S BQIUPD(90506.1,DA_",",5)="S VAL=$$AUD^BQIRGDMA("_EXEC_")"
. S BQIUPD(90506.1,DA_",",5)="S VAL="_EXEC
. D FILE^DIE("E","BQIUPD","ERROR")
. K BQIUPD
. S HELP(1)="Diabetes Audit "_NYR_" for "_TEXT_"."
. D WP^DIE(90506.1,DA_",",4,"","HELP","ERROR")
. K HELP
Q
;
TAX(YEAR) ; Set up Taxonomies for Diabetes Register
NEW TXN,RGN,IEN,VALUE,TAX,FILE,SITE,TAX,BQIUPD
S TXN=$O(^BDMTAXS("B",YEAR,"")) I TXN="" Q
S RGN=$O(^BQI(90507,"B","DIABETES","")) I RGN="" Q
S IEN=0
F S IEN=$O(^BDMTAXS(TXN,11,IEN)) Q:'IEN D
. S VALUE=^BDMTAXS(TXN,11,IEN,0)
. S TAX=$P(VALUE,U,1),FILE=$P(VALUE,U,2),SITE=$P(VALUE,U,3)
. NEW DA,DIC,IENS,GLB,TAXN,TXDN,CN,CAT,ID
. S DA(1)=RGN,DIC(0)="LNZ",DLAYGO=90507.01,DIC="^BQI(90507,"_DA(1)_",10,"
. I $G(^BQI(90507,DA(1),10,0))="" S ^BQI(90507,DA(1),10,0)="^90507.01^^"
. S X=TAX
. D ^DIC
. I +Y=-1 K DO,DD D FILE^DICN
. S DA=+Y,IENS=$$IENS^DILF(.DA)
. S BQIUPD(90507.01,IENS,.04)=$S(SITE=1:1,1:"")
. S GLB=$S(FILE=60:"^ATXLAB",1:"^ATXAX")
. S TAXN=$O(@GLB@("B",TAX,"")) I TAXN="" Q
. S TXDN=$O(^BQI(90508.4,"B",FILE,"")) I TXDN="" Q
. S CN=$P(^BQI(90508.4,TXDN,0),U,2)
. I $G(CN)'="" S CAT=$P(^BQI(90508.3,CN,0),U,1),ID=$P(^BQI(90508.3,CN,0),U,2)
. I CAT="" S CAT="OTHER",ID="OTHER"
. S BQIUPD(90507.01,IENS,.03)=CAT
. S BQIUPD(90507.01,IENS,.02)=TAXN_";"_$P(GLB,U,2)_"("
. S BQIUPD(90507.01,IENS,.05)=$$STCC^BQIUL2(90507.01,.05,ID)
. D FILE^DIE("","BQIUPD","ERROR")
Q
;
AUD(EVAL) ;EP - Execute DM Audit executable
;NEW BDMPD,BDMRBD,BDMRED,BDMBDAT,BDMADAT,BDMDMRG,BDM6MBD
S RESULT=0
I EVAL="" D
. S EVAL=$P(EXEC,"(",2,99)
. S EVAL=$P(EVAL,")",1)
. S EVAL=EVAL_")"
;S EVAL="S RES="_$TR(EVAL,"~","^")
S BDMPD=DFN,BDMADAT=DT,BDMDMRG=$P($G(^BQI(90508,1,"DM")),U,2)
S BDM6MBD=$$FMADD^XLFDT(BDMADAT,-(6*31))
S BDMBDAT=$$FMADD^XLFDT(BDMADAT,-365),BDMRBD=$$FMTE^XLFDT(BDMBDAT),BDMRED=$$FMTE^XLFDT(BDMADAT)
S EVAL="S RES="_EVAL
X EVAL
I RES'="" S RESULT=1_U_RES
Q RESULT
;
GLS(DATA,FAKE) ;EP - BQI GET DM AUDIT GLOSSARY
NEW UID,II,TRIEN,CAT,TIT,SORT,RMK,REMARK,CT,NXT,GLIEN,IEN
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIRGDMGLS",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRGPG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T32767REPORT_TEXT"_$C(30)
S PRVY=$P($G(^BQI(90508,1,"DM")),U,1)
S NYRN=$O(^BDMDMTX("B",PRVY,"")) I NYRN="" G DONE
S IEN=0
F S IEN=$O(^BDMDMTX(NYRN,11,IEN)) Q:'IEN D
. S II=II+1,@DATA@(II)=$P(^BDMDMTX(NYRN,11,IEN,0),U,1)_$C(10)_$C(13)
. ;S II=II+1,@DATA@(II)=" "_$C(10)_$C(13)
. S GLIEN=0
. F S GLIEN=$O(^BDMDMTX(NYRN,11,IEN,11,GLIEN)) Q:'GLIEN D
.. S II=II+1,@DATA@(II)=" "_$G(^BDMDMTX(NYRN,11,IEN,11,GLIEN,0))_$C(10)_$C(13)
. S II=II+1,@DATA@(II)=" "_$C(10)_$C(13)
I II>0 S @DATA@(II)=@DATA@(II)_$C(30)
;
DONE S II=II+1,@DATA@(II)=$C(31)
Q
;
DSP(RGDFN,RGSTVW) ;EP = Display Audit information
NEW VALUE,RESULT,RGPIEN,CRIEN,CMSN,LINK
S CODE=$P($G(^BQI(90506.1,RGSTVW,0)),U,1) I CODE="" Q ""
;S RGSTVW=$O(^BQI(90506.1,"B",CODE,"")) I RGSTVW="" Q ""
I $P(^BQI(90506.1,RGSTVW,0),"^",10)=1 Q ""
S CMSN=$P($G(^BQI(90506.1,RGSTVW,3)),U,1) I CMSN="" Q ""
S CRIEN=$O(^BQIPAT(RGDFN,60,"B",CMSN,"")) I CRIEN="" Q ""
S RGPIEN="",VALUE="",HOVER="",LINK="",RESULT=""
F S RGPIEN=$O(^BQIPAT(RGDFN,60,CRIEN,1,"B",CODE,RGPIEN)) Q:RGPIEN="" D
. S VALUE=$P($G(^BQIPAT(RGDFN,60,CRIEN,1,RGPIEN,0)),U,2)
. S HOVER=$P($G(^BQIPAT(RGDFN,60,CRIEN,1,RGPIEN,0)),U,5)
. S LINK=$P($G(^BQIPAT(RGDFN,60,CRIEN,1,RGPIEN,0)),U,4)
I VALUE'="" D
. I $L(VALUE," ")=2 S VALUE=$$UP^XLFSTR($P(VALUE," ",2)) Q
. ;I $L(VALUE," ")=2 S VALUE=$$UP^XLFSTR($P(VALUE," ",2)) Q
. I $P(VALUE," ",1)=1!($P(VALUE," ",1)=2)!($P(VALUE," ",1)=3) S VALUE=$P(VALUE," ",2,99) Q
. I VALUE?.7N,$$FMTE^BQIUL1(VALUE)'="" S VALUE=$$FMTE^XLFDT(VALUE,"5Z") Q
. Q
I VALUE'="",HOVER'="" S RESULT=VALUE_$C(26)_HOVER_$C(26)_LINK
E S RESULT=VALUE
Q RESULT
;
THER ;EP - Therapy who don't have an order
;;DM_INSU
;;DM_SULF
;;DM_SULFL
;;DM_METFOR
;;DM_ACAR
;;DM_PIOG
;;DM_DPP4
;;DM_AMYL
;;DM_GLP
;;DM_BROMO
;;DM_COLES
;;DM_SGLT2
BQIRGDMA ;VNGT/HS/ALA-Set up Diabetes Audit fields ; 17 Feb 2016 2:46 PM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
EN ;EP - Update Diabetes Audit when new one comes in
+1 NEW PRVY,DMN,YR,NYRN,NYR,BQIGDA,BQIN1,BQIN2,DVY
+2 SET PRVY=$PIECE($GET(^BQI(90508,1,"DM")),U,1)
+3 IF PRVY'=""
SET NYR=PRVY+1
+4 IF PRVY=""
SET DVY=$PIECE($$FMTE^XLFDT(DT,7),"/",1)
Begin DoDot:1
+5 IF '$DATA(^BDMDMTX("B",DVY))
SET NYR=DVY-1
QUIT
+6 IF $DATA(^BDMDMTX("B",DVY))
SET NYR=DVY
End DoDot:1
+7 ;
+8 SET NYRN=$ORDER(^BDMDMTX("B",NYR,""))
IF NYRN=""
QUIT
+9 SET BQIN1=$PIECE(^BDMDMTX(NYRN,0),U,2)
SET BQIN2=$PIECE(^(0),U,3)
+10 IF PRVY'=NYR
Begin DoDot:1
+11 SET BQIDA=1
+12 NEW DA,IENS,DIC
+13 SET DA(1)=BQIDA
SET X=NYR
SET DIC(0)="LMNZ"
SET DIC="^BQI(90508,"_DA(1)_",21,"
+14 DO ^DIC
+15 IF +Y<1
QUIT
+16 SET BQIGDA=+Y
+17 SET DA=BQIGDA
SET IENS=$$IENS^DILF(.DA)
+18 SET BQIUPD(90508.021,IENS,.02)=BQIN1
+19 SET BQIUPD(90508.021,IENS,.03)=BQIN2
+20 SET BQIUPD(90508.021,IENS,.04)="BDMDM"_$EXTRACT(NYR,3,4)
+21 SET BQIUPD(90508,BQIDA_",",21.01)=NYR
+22 DO FILE^DIE("","BQIUPD","ERROR")
+23 DO TAX(NYR)
+24 ;
+25 DO AU
+26 ;
+27 DO JBDM^BQITASK2
End DoDot:1
+28 QUIT
+29 ;
AU ; Update Dm Audit in 90506.5
+1 NEW BDMN,CODE,EXEC,IEN,BDMDATA,IEN,BQIUPD,TBDMN,TEXT
+2 SET IEN=""
+3 FOR
SET IEN=$ORDER(^BQI(90506.1,"AC","DM",IEN))
IF IEN=""
QUIT
Begin DoDot:1
+4 SET BQIUPD(90506.1,IEN_",",.1)=1
+5 IF $PIECE(^BQI(90506.1,IEN,0),U,11)=""
SET BQIUPD(90506.1,IEN_",",.11)=DT
End DoDot:1
+6 DO FILE^DIE("","BQIUPD","ERROR")
+7 KILL BQIUPD
+8 ;
+9 SET BDMN=0
+10 FOR
SET BDMN=$ORDER(^BDMDMTX(NYRN,11,BDMN))
IF 'BDMN
QUIT
Begin DoDot:1
+11 SET BDMDATA=$GET(^BDMDMTX(NYRN,11,BDMN,1))
IF BDMDATA=""
QUIT
+12 IF $PIECE(BDMDATA,U,4)=""
QUIT
+13 SET CODE="DM_"_$PIECE(BDMDATA,U,4)
SET EXEC=$TRANSLATE($PIECE(BDMDATA,U,3),"~","^")
+14 IF CODE="DM_COMB"
IF EXEC["COMBINEE"
SET EXEC="$$COMBINED^BDMDD1C(BDMPD)"
+15 IF CODE="DM_HDL"
IF EXEC["$$LDL"
Begin DoDot:2
+16 IF NYR=2016
SET EXEC="$$HDL^BDMDD18(BDMPD,BDMBDAT,BDMADAT)"
+17 IF NYR=2015
SET EXEC="$$HDL^BDMDC18(BDMPD,BDMBDAT,BDMADAT)"
End DoDot:2
+18 SET HDR="T00030"_CODE
SET NSOURCE="DM Audit"
SET NCLIN=""
SET NCAT=$PIECE(BDMDATA,U,2)
+19 SET ORD=$PIECE(^BDMDMTX(NYRN,11,BDMN,0),"^",3)
+20 IF ORD=""
Begin DoDot:2
+21 FOR I=1:1:12
SET TEXT=$PIECE($TEXT(THER+I),";;",2)
IF TEXT=""
QUIT
Begin DoDot:3
+22 SET TBDMN=$ORDER(^BDMDMTX(NYRN,11,"B","DM THERAPY",""))
IF TBDMN=""
SET TBDMN=$ORDER(^BDMDMTX(NYRN,11,"B","DIABETES THERAPY",""))
IF TBDMN=""
QUIT
+23 IF CODE=TEXT
SET ORD=$PIECE(^BDMDMTX(NYRN,11,TBDMN,0),"^",3)
End DoDot:3
End DoDot:2
+24 SET TEXT=$PIECE(BDMDATA,U,1)
+25 IF CODE="DM_TBTEST"
SET TEXT="TB Test Done"
+26 NEW DA,X,DIC,DLAYGO
+27 SET DIC="^BQI(90506.1,"
SET DIC(0)="L"
SET X=CODE
+28 SET DA=$ORDER(^BQI(90506.1,"B",CODE,""))
+29 ;I DA'="" S ORD=$O(^BQI(90506.1,"AD","DM",""),-1)+1
+30 IF DA=""
Begin DoDot:2
+31 KILL DO,DD
DO FILE^DICN
+32 SET DA=+Y
IF DA=-1
SET ERROR=1
+33 ;S ORD=$O(^BQI(90506.1,"AD","DM",""),-1)+1
End DoDot:2
IF $GET(ERROR)=1
QUIT
+34 SET BQIUPD(90506.1,DA_",",.03)=TEXT
+35 SET BQIUPD(90506.1,DA_",",.08)=HDR
+36 SET BQIUPD(90506.1,DA_",",.15)=120
+37 SET BQIUPD(90506.1,DA_",",.1)="@"
+38 SET BQIUPD(90506.1,DA_",",.11)="@"
+39 DO FILE^DIE("","BQIUPD","ERROR")
+40 ;
+41 SET BQIUPD(90506.1,DA_",",3.01)=NSOURCE
+42 SET BQIUPD(90506.1,DA_",",3.02)=NCLIN
+43 SET BQIUPD(90506.1,DA_",",3.03)=NCAT
+44 SET BQIUPD(90506.1,DA_",",3.04)="Default"
+45 SET BQIUPD(90506.1,DA_",",3.05)=ORD
+46 SET BQIUPD(90506.1,DA_",",1)="S VAL=$$DSP^BQIRGDMA(DFN,STVW)"
+47 ;S BQIUPD(90506.1,DA_",",5)="S VAL=$$AUD^BQIRGDMA("_EXEC_")"
+48 SET BQIUPD(90506.1,DA_",",5)="S VAL="_EXEC
+49 DO FILE^DIE("E","BQIUPD","ERROR")
+50 KILL BQIUPD
+51 SET HELP(1)="Diabetes Audit "_NYR_" for "_TEXT_"."
+52 DO WP^DIE(90506.1,DA_",",4,"","HELP","ERROR")
+53 KILL HELP
End DoDot:1
+54 QUIT
+55 ;
TAX(YEAR) ; Set up Taxonomies for Diabetes Register
+1 NEW TXN,RGN,IEN,VALUE,TAX,FILE,SITE,TAX,BQIUPD
+2 SET TXN=$ORDER(^BDMTAXS("B",YEAR,""))
IF TXN=""
QUIT
+3 SET RGN=$ORDER(^BQI(90507,"B","DIABETES",""))
IF RGN=""
QUIT
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(^BDMTAXS(TXN,11,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+6 SET VALUE=^BDMTAXS(TXN,11,IEN,0)
+7 SET TAX=$PIECE(VALUE,U,1)
SET FILE=$PIECE(VALUE,U,2)
SET SITE=$PIECE(VALUE,U,3)
+8 NEW DA,DIC,IENS,GLB,TAXN,TXDN,CN,CAT,ID
+9 SET DA(1)=RGN
SET DIC(0)="LNZ"
SET DLAYGO=90507.01
SET DIC="^BQI(90507,"_DA(1)_",10,"
+10 IF $GET(^BQI(90507,DA(1),10,0))=""
SET ^BQI(90507,DA(1),10,0)="^90507.01^^"
+11 SET X=TAX
+12 DO ^DIC
+13 IF +Y=-1
KILL DO,DD
DO FILE^DICN
+14 SET DA=+Y
SET IENS=$$IENS^DILF(.DA)
+15 SET BQIUPD(90507.01,IENS,.04)=$SELECT(SITE=1:1,1:"")
+16 SET GLB=$SELECT(FILE=60:"^ATXLAB",1:"^ATXAX")
+17 SET TAXN=$ORDER(@GLB@("B",TAX,""))
IF TAXN=""
QUIT
+18 SET TXDN=$ORDER(^BQI(90508.4,"B",FILE,""))
IF TXDN=""
QUIT
+19 SET CN=$PIECE(^BQI(90508.4,TXDN,0),U,2)
+20 IF $GET(CN)'=""
SET CAT=$PIECE(^BQI(90508.3,CN,0),U,1)
SET ID=$PIECE(^BQI(90508.3,CN,0),U,2)
+21 IF CAT=""
SET CAT="OTHER"
SET ID="OTHER"
+22 SET BQIUPD(90507.01,IENS,.03)=CAT
+23 SET BQIUPD(90507.01,IENS,.02)=TAXN_";"_$PIECE(GLB,U,2)_"("
+24 SET BQIUPD(90507.01,IENS,.05)=$$STCC^BQIUL2(90507.01,.05,ID)
+25 DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:1
+26 QUIT
+27 ;
AUD(EVAL) ;EP - Execute DM Audit executable
+1 ;NEW BDMPD,BDMRBD,BDMRED,BDMBDAT,BDMADAT,BDMDMRG,BDM6MBD
+2 SET RESULT=0
+3 IF EVAL=""
Begin DoDot:1
+4 SET EVAL=$PIECE(EXEC,"(",2,99)
+5 SET EVAL=$PIECE(EVAL,")",1)
+6 SET EVAL=EVAL_")"
End DoDot:1
+7 ;S EVAL="S RES="_$TR(EVAL,"~","^")
+8 SET BDMPD=DFN
SET BDMADAT=DT
SET BDMDMRG=$PIECE($GET(^BQI(90508,1,"DM")),U,2)
+9 SET BDM6MBD=$$FMADD^XLFDT(BDMADAT,-(6*31))
+10 SET BDMBDAT=$$FMADD^XLFDT(BDMADAT,-365)
SET BDMRBD=$$FMTE^XLFDT(BDMBDAT)
SET BDMRED=$$FMTE^XLFDT(BDMADAT)
+11 SET EVAL="S RES="_EVAL
+12 XECUTE EVAL
+13 IF RES'=""
SET RESULT=1_U_RES
+14 QUIT RESULT
+15 ;
GLS(DATA,FAKE) ;EP - BQI GET DM AUDIT GLOSSARY
+1 NEW UID,II,TRIEN,CAT,TIT,SORT,RMK,REMARK,CT,NXT,GLIEN,IEN
+2 ;
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQIRGDMGLS",UID))
+5 KILL @DATA
+6 ;
+7 SET II=0
+8 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRGPG D UNWIND^%ZTER"
+9 ;
+10 SET @DATA@(II)="T32767REPORT_TEXT"_$CHAR(30)
+11 SET PRVY=$PIECE($GET(^BQI(90508,1,"DM")),U,1)
+12 SET NYRN=$ORDER(^BDMDMTX("B",PRVY,""))
IF NYRN=""
GOTO DONE
+13 SET IEN=0
+14 FOR
SET IEN=$ORDER(^BDMDMTX(NYRN,11,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+15 SET II=II+1
SET @DATA@(II)=$PIECE(^BDMDMTX(NYRN,11,IEN,0),U,1)_$CHAR(10)_$CHAR(13)
+16 ;S II=II+1,@DATA@(II)=" "_$C(10)_$C(13)
+17 SET GLIEN=0
+18 FOR
SET GLIEN=$ORDER(^BDMDMTX(NYRN,11,IEN,11,GLIEN))
IF 'GLIEN
QUIT
Begin DoDot:2
+19 SET II=II+1
SET @DATA@(II)=" "_$GET(^BDMDMTX(NYRN,11,IEN,11,GLIEN,0))_$CHAR(10)_$CHAR(13)
End DoDot:2
+20 SET II=II+1
SET @DATA@(II)=" "_$CHAR(10)_$CHAR(13)
End DoDot:1
+21 IF II>0
SET @DATA@(II)=@DATA@(II)_$CHAR(30)
+22 ;
DONE SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
DSP(RGDFN,RGSTVW) ;EP = Display Audit information
+1 NEW VALUE,RESULT,RGPIEN,CRIEN,CMSN,LINK
+2 SET CODE=$PIECE($GET(^BQI(90506.1,RGSTVW,0)),U,1)
IF CODE=""
QUIT ""
+3 ;S RGSTVW=$O(^BQI(90506.1,"B",CODE,"")) I RGSTVW="" Q ""
+4 IF $PIECE(^BQI(90506.1,RGSTVW,0),"^",10)=1
QUIT ""
+5 SET CMSN=$PIECE($GET(^BQI(90506.1,RGSTVW,3)),U,1)
IF CMSN=""
QUIT ""
+6 SET CRIEN=$ORDER(^BQIPAT(RGDFN,60,"B",CMSN,""))
IF CRIEN=""
QUIT ""
+7 SET RGPIEN=""
SET VALUE=""
SET HOVER=""
SET LINK=""
SET RESULT=""
+8 FOR
SET RGPIEN=$ORDER(^BQIPAT(RGDFN,60,CRIEN,1,"B",CODE,RGPIEN))
IF RGPIEN=""
QUIT
Begin DoDot:1
+9 SET VALUE=$PIECE($GET(^BQIPAT(RGDFN,60,CRIEN,1,RGPIEN,0)),U,2)
+10 SET HOVER=$PIECE($GET(^BQIPAT(RGDFN,60,CRIEN,1,RGPIEN,0)),U,5)
+11 SET LINK=$PIECE($GET(^BQIPAT(RGDFN,60,CRIEN,1,RGPIEN,0)),U,4)
End DoDot:1
+12 IF VALUE'=""
Begin DoDot:1
+13 IF $LENGTH(VALUE," ")=2
SET VALUE=$$UP^XLFSTR($PIECE(VALUE," ",2))
QUIT
+14 ;I $L(VALUE," ")=2 S VALUE=$$UP^XLFSTR($P(VALUE," ",2)) Q
+15 IF $PIECE(VALUE," ",1)=1!($PIECE(VALUE," ",1)=2)!($PIECE(VALUE," ",1)=3)
SET VALUE=$PIECE(VALUE," ",2,99)
QUIT
+16 IF VALUE?.7N
IF $$FMTE^BQIUL1(VALUE)'=""
SET VALUE=$$FMTE^XLFDT(VALUE,"5Z")
QUIT
+17 QUIT
End DoDot:1
+18 IF VALUE'=""
IF HOVER'=""
SET RESULT=VALUE_$CHAR(26)_HOVER_$CHAR(26)_LINK
+19 IF '$TEST
SET RESULT=VALUE
+20 QUIT RESULT
+21 ;
THER ;EP - Therapy who don't have an order
+1 ;;DM_INSU
+2 ;;DM_SULF
+3 ;;DM_SULFL
+4 ;;DM_METFOR
+5 ;;DM_ACAR
+6 ;;DM_PIOG
+7 ;;DM_DPP4
+8 ;;DM_AMYL
+9 ;;DM_GLP
+10 ;;DM_BROMO
+11 ;;DM_COLES
+12 ;;DM_SGLT2
