- 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
