BQICMLST ;VNGT/HS/ALA-Care Management List ; 28 May 2008 6:59 PM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
Q
;
EN(DATA,TYPE) ;EP -- BQI GET CARE MGMT LIST
;
; Input
; TYPE - type of measures to list see table 90506.5 for list
;
NEW UID,II,TTYPE,SCAT,SCLIN,BQMEAS,CAT,CLIN,TITLE,BATCH,BQIMEASF,CMCOD
NEW EDIT,NCAT,NCLIN,NVIEW,ORD,PIND,YEAR,SDIR,BQISORT,INACTIVE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQICMLST",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQICMLST D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="I00010MEAS_IEN^T00030TYPE^T00030CATEGORY^T00030CLIN_GROUP^T00050DISPLAY_NAME^T00015CODE^T00001VIEW^T00001PER_DIRECT^"
S @DATA@(II)=@DATA@(II)_"T00001EXCEPT^I00003SIZE^T00003EDIT^T00003BATCH^T00001DEFAULT_SORT"_$C(30)
;
S TYPE=$G(TYPE,"")
;
I TYPE'="" D G DONE
. N TPC,NTYPE
. F TPC=1:1:$L(TYPE,$C(29)) S NTYPE=$P(TYPE,$C(29),TPC) I NTYPE]"" D
.. I NTYPE'?.N S CMCOD=$$FIND1^DIC(90506.5,"","X",NTYPE,"B","","ERROR")
.. I CMCOD=0 S CMCOD=$$FIND1^DIC(90506.5,"","X",NTYPE,"C","","ERROR")
.. I NTYPE?.N S CMCOD=NTYPE
.. ;
.. S TTYPE=$P($G(^BQI(90506.5,CMCOD,0)),U,2)
.. I TTYPE'="" D RET
.. ;
.. ;Get care management columns
.. D CMGT
;
S TTYPE=""
F S TTYPE=$O(^BQI(90506.5,"C",TTYPE)) Q:TTYPE="" D
. S CMCOD=$O(^BQI(90506.5,"C",TTYPE,""))
. S INACTIVE=$$GET1^DIQ(90506.5,CMCOD_",",.1,"I") Q:INACTIVE
. S IEN=$O(^BQI(90506.1,"AD",TTYPE,""))
. ;I IEN="" D CMGT Q
. I IEN'="" D RET
. D CMGT
. ;D RET
;
DONE ;
S SRC=""
F S SRC=$O(BQISORT(SRC)) Q:SRC="" D
. S CAT=""
. F S CAT=$O(BQISORT(SRC,CAT)) Q:CAT="" D
.. S CLIN=""
.. F S CLIN=$O(BQISORT(SRC,CAT,CLIN)) Q:CLIN="" D
... S TITLE=""
... F S TITLE=$O(BQISORT(SRC,CAT,CLIN,TITLE)) Q:TITLE="" D
.... S BQMEAS=""
.... F S BQMEAS=$O(BQISORT(SRC,CAT,CLIN,TITLE,BQMEAS)) Q:BQMEAS="" D
..... S II=II+1,@DATA@(II)=BQISORT(SRC,CAT,CLIN,TITLE,BQMEAS)
S II=II+1,@DATA@(II)=$C(31)
K BQISORT
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
;
RET ; Data retrieval
NEW IEN,FDATA,SRC,GCAT,RCAT,DCAT,GCLIN,RCLIN,GVIEW,DVIEW,VIEW,DCLIN
NEW CAT,CLIN,RVIEW,MVIEW,PDIR,EXCEPT,SIZE,SRCN,KEY
; Check for Alternate Display Order fist
S ORD=""
F S ORD=$O(^BQI(90506.1,"AF",TTYPE,ORD)) Q:ORD="" D
. S IEN=""
. F S IEN=$O(^BQI(90506.1,"AF",TTYPE,ORD,IEN)) Q:IEN="" D GET(IEN)
;
; Get normal order
S ORD=""
F S ORD=$O(^BQI(90506.1,"AD",TTYPE,ORD)) Q:ORD="" D
. S IEN=""
. F S IEN=$O(^BQI(90506.1,"AD",TTYPE,ORD,IEN)) Q:IEN="" D GET(IEN)
Q
;
GET(IEN) ;EP - Get data values
S FDATA=$G(^BQI(90506.1,IEN,0)),EXCEPT="",SIZE=""
I $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1 Q
I $$GET1^DIQ(90506.1,IEN_",",3.07,"I")=1 Q
S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
S SRCN=$$GET1^DIQ(90506.1,IEN_",",3.01,"I")
S SRC=$S($$GET1^DIQ(90506.5,SRCN_",",.06,"E")'="":$$GET1^DIQ(90506.5,SRCN_",",.06,"E"),1:$$GET1^DIQ(90506.5,SRCN_",",.01,"E"))
;S SRC=$$GET1^DIQ(90506.1,IEN_",",3.01,"E")
S NCAT=$$GET1^DIQ(90506.1,IEN_",",3.03,"E")
S NCLIN=$$GET1^DIQ(90506.1,IEN_",",3.02,"E")
S NVIEW=$$GET1^DIQ(90506.1,IEN_",",3.04,"I")
S PDIR=$$GET1^DIQ(90506.1,IEN_",",.14,"I")
S SIZE=$$GET1^DIQ(90506.1,IEN_",",.15,"E")
S EDIT=+$$GET1^DIQ(90506.1,IEN_",",.16,"I")
S EDIT=$S(EDIT=1:"YES",1:"NO")
S BATCH=+$$GET1^DIQ(90506.1,IEN_",",.17,"I")
S BATCH=$S(BATCH=1:"YES",1:"NO")
S SDIR=$$GET1^DIQ(90506.1,IEN_",",3.08,"I")
S:SDIR="" SDIR="A"
S VIEW=NVIEW
S:VIEW="" VIEW="O"
S DCLIN=""
S CAT=NCAT
S CLIN=NCLIN
I TTYPE="G" D
. NEW CODE,BQIH,BQIYR,BQMEAS,VER
. S CODE=$P(FDATA,U,1),YEAR=$P(CODE,"_",1)
. S BQMEAS=$P(CODE,"_",2)
. S BQIH=$$SPM^BQIGPUTL()
. S BQIYR=$$LKP^BQIGPUTL(YEAR)
. S VER=$$VERSION^XPDUTL("BGP")
. I VER>7.0 D
.. D GFN^BQIGPUTL(BQIH,BQIYR)
.. S EXCEPT=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1704,"I")
.. S EXCEPT=$S(EXCEPT="Y":"C",1:"N")
.. S PDIR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1705,"E")
S SCAT=$S(CAT="":"@",1:CAT),SCLIN=$S(CLIN="":"@",1:CLIN)
S BQISORT(SRC,SCAT,SCLIN,$P(FDATA,U,3),IEN)=IEN_U_SRC_U_CAT_U_CLIN_U_$P(FDATA,U,3)_U_$P(FDATA,U,1)_U_VIEW_U_$G(PDIR)_U_$G(EXCEPT)_U_SIZE_U_EDIT_U_BATCH_U_SDIR_$C(30)
;S II=II+1,@DATA@(II)=IEN_U_SRC_U_CAT_U_CLIN_U_$P(FDATA,U,3)_U_$P(FDATA,U,1)_U_VIEW_U_PDIR_U_EXCEPT_U_SIZE_U_EDIT_U_BATCH_U_SDIR_$C(30)
Q
;
CMGT ; Additional Care Mgmt columns
NEW KEY,DXCL,FDATA,CAT,REQ,SRC,FTY,CLIN,SCLIN
S KEY=$P(^BQI(90506.5,CMCOD,0),U,12)
I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
S DXCL=0
F S DXCL=$O(^BQI(90506.5,CMCOD,10,DXCL)) Q:'DXCL D
. S FDATA=^BQI(90506.5,CMCOD,10,DXCL,0)
. I $P(FDATA,U,9)=1 Q
. S FTY=$P(FDATA,U,2),CAT="",CLIN="",SCLIN=""
. S CAT=$P($G(^BQI(90506.5,CMCOD,10,DXCL,5)),"^",2),CLIN=$P($G(^BQI(90506.5,CMCOD,10,DXCL,5)),"^",1)
. I FTY'="" D
.. I CAT'=""!(CLIN'="") Q
.. S CAT=$$GET1^DIQ(90621.1,FTY_",",.07,"E")
.. I CAT="Other" S CLIN=$$GET1^DIQ(90621.1,FTY_",",.08,"E"),SCLIN=$$LOWER^VALM1(CLIN)
.. ;I CLIN="" S CLIN="@",SCLIN=""
. S REQ=$S($P(FDATA,U,6)'="":$P(FDATA,U,6),1:"O")
. S SCAT=$S(CAT="":"@",1:CAT),SCLIN=$S(CLIN="":"@",1:CLIN)
. S SRC=$S($$GET1^DIQ(90506.5,CMCOD_",",.06,"E")'="":$$GET1^DIQ(90506.5,CMCOD_",",.06,"E"),1:$$GET1^DIQ(90506.5,CMCOD_",",.01,"E"))
. S BQISORT(SRC,SCAT,SCLIN,$P(FDATA,U,3),DXCL)=DXCL_U_SRC_U_CAT_U_CLIN_U_$P(FDATA,U,3)_U_$P(FDATA,U,1)_U_REQ_U_U_U_U_U_U_$C(30)
. ;
;Get locally created care management columns if associated with a dx tag
NEW DXTN
S DXTN=$P($G(^BQI(90506.5,CMCOD,0)),U,11) I DXTN="" Q
S DXCL=0
F S DXCL=$O(^BQI(90506.2,DXTN,6,DXCL)) Q:'DXCL D
. S CAT="Local",CLIN="",SCLIN=""
. S FDATA=^BQI(90506.2,DXTN,6,DXCL,0)
. I $P(FDATA,U,9)=1 Q
. S REQ=$S($P(FDATA,U,6)'="":$P(FDATA,U,6),1:"O")
. S SCAT=$S(CAT="":"@",1:CAT),SCLIN=$S(CLIN="":"@",1:CLIN)
. S SRC=$S($$GET1^DIQ(90506.5,CMCOD_",",.06,"E")'="":$$GET1^DIQ(90506.5,CMCOD_",",.06,"E"),1:$$GET1^DIQ(90506.5,CMCOD_",",.01,"E"))
. S BQISORT(SCAT,SCLIN,$P(FDATA,U,3),DXCL)=DXCL_U_SRC_U_CAT_U_CLIN_U_$P(FDATA,U,3)_U_$P(FDATA,U,1)_U_REQ_U_U_U_U_U_U_$C(30)
Q
BQICMLST ;VNGT/HS/ALA-Care Management List ; 28 May 2008 6:59 PM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
+3 QUIT
+4 ;
EN(DATA,TYPE) ;EP -- BQI GET CARE MGMT LIST
+1 ;
+2 ; Input
+3 ; TYPE - type of measures to list see table 90506.5 for list
+4 ;
+5 NEW UID,II,TTYPE,SCAT,SCLIN,BQMEAS,CAT,CLIN,TITLE,BATCH,BQIMEASF,CMCOD
+6 NEW EDIT,NCAT,NCLIN,NVIEW,ORD,PIND,YEAR,SDIR,BQISORT,INACTIVE
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET DATA=$NAME(^TMP("BQICMLST",UID))
+9 KILL @DATA
+10 ;
+11 SET II=0
+12 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQICMLST D UNWIND^%ZTER"
+13 ;
+14 SET @DATA@(II)="I00010MEAS_IEN^T00030TYPE^T00030CATEGORY^T00030CLIN_GROUP^T00050DISPLAY_NAME^T00015CODE^T00001VIEW^T00001PER_DIRECT^"
+15 SET @DATA@(II)=@DATA@(II)_"T00001EXCEPT^I00003SIZE^T00003EDIT^T00003BATCH^T00001DEFAULT_SORT"_$CHAR(30)
+16 ;
+17 SET TYPE=$GET(TYPE,"")
+18 ;
+19 IF TYPE'=""
Begin DoDot:1
+20 NEW TPC,NTYPE
+21 FOR TPC=1:1:$LENGTH(TYPE,$CHAR(29))
SET NTYPE=$PIECE(TYPE,$CHAR(29),TPC)
IF NTYPE]""
Begin DoDot:2
+22 IF NTYPE'?.N
SET CMCOD=$$FIND1^DIC(90506.5,"","X",NTYPE,"B","","ERROR")
+23 IF CMCOD=0
SET CMCOD=$$FIND1^DIC(90506.5,"","X",NTYPE,"C","","ERROR")
+24 IF NTYPE?.N
SET CMCOD=NTYPE
+25 ;
+26 SET TTYPE=$PIECE($GET(^BQI(90506.5,CMCOD,0)),U,2)
+27 IF TTYPE'=""
DO RET
+28 ;
+29 ;Get care management columns
+30 DO CMGT
End DoDot:2
End DoDot:1
GOTO DONE
+31 ;
+32 SET TTYPE=""
+33 FOR
SET TTYPE=$ORDER(^BQI(90506.5,"C",TTYPE))
IF TTYPE=""
QUIT
Begin DoDot:1
+34 SET CMCOD=$ORDER(^BQI(90506.5,"C",TTYPE,""))
+35 SET INACTIVE=$$GET1^DIQ(90506.5,CMCOD_",",.1,"I")
IF INACTIVE
QUIT
+36 SET IEN=$ORDER(^BQI(90506.1,"AD",TTYPE,""))
+37 ;I IEN="" D CMGT Q
+38 IF IEN'=""
DO RET
+39 DO CMGT
+40 ;D RET
End DoDot:1
+41 ;
DONE ;
+1 SET SRC=""
+2 FOR
SET SRC=$ORDER(BQISORT(SRC))
IF SRC=""
QUIT
Begin DoDot:1
+3 SET CAT=""
+4 FOR
SET CAT=$ORDER(BQISORT(SRC,CAT))
IF CAT=""
QUIT
Begin DoDot:2
+5 SET CLIN=""
+6 FOR
SET CLIN=$ORDER(BQISORT(SRC,CAT,CLIN))
IF CLIN=""
QUIT
Begin DoDot:3
+7 SET TITLE=""
+8 FOR
SET TITLE=$ORDER(BQISORT(SRC,CAT,CLIN,TITLE))
IF TITLE=""
QUIT
Begin DoDot:4
+9 SET BQMEAS=""
+10 FOR
SET BQMEAS=$ORDER(BQISORT(SRC,CAT,CLIN,TITLE,BQMEAS))
IF BQMEAS=""
QUIT
Begin DoDot:5
+11 SET II=II+1
SET @DATA@(II)=BQISORT(SRC,CAT,CLIN,TITLE,BQMEAS)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+13 KILL BQISORT
+14 QUIT
+15 ;
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 ;
RET ; Data retrieval
+1 NEW IEN,FDATA,SRC,GCAT,RCAT,DCAT,GCLIN,RCLIN,GVIEW,DVIEW,VIEW,DCLIN
+2 NEW CAT,CLIN,RVIEW,MVIEW,PDIR,EXCEPT,SIZE,SRCN,KEY
+3 ; Check for Alternate Display Order fist
+4 SET ORD=""
+5 FOR
SET ORD=$ORDER(^BQI(90506.1,"AF",TTYPE,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+6 SET IEN=""
+7 FOR
SET IEN=$ORDER(^BQI(90506.1,"AF",TTYPE,ORD,IEN))
IF IEN=""
QUIT
DO GET(IEN)
End DoDot:1
+8 ;
+9 ; Get normal order
+10 SET ORD=""
+11 FOR
SET ORD=$ORDER(^BQI(90506.1,"AD",TTYPE,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+12 SET IEN=""
+13 FOR
SET IEN=$ORDER(^BQI(90506.1,"AD",TTYPE,ORD,IEN))
IF IEN=""
QUIT
DO GET(IEN)
End DoDot:1
+14 QUIT
+15 ;
GET(IEN) ;EP - Get data values
+1 SET FDATA=$GET(^BQI(90506.1,IEN,0))
SET EXCEPT=""
SET SIZE=""
+2 IF $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1
QUIT
+3 IF $$GET1^DIQ(90506.1,IEN_",",3.07,"I")=1
QUIT
+4 SET KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
+5 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+6 SET SRCN=$$GET1^DIQ(90506.1,IEN_",",3.01,"I")
+7 SET SRC=$SELECT($$GET1^DIQ(90506.5,SRCN_",",.06,"E")'="":$$GET1^DIQ(90506.5,SRCN_",",.06,"E"),1:$$GET1^DIQ(90506.5,SRCN_",",.01,"E"))
+8 ;S SRC=$$GET1^DIQ(90506.1,IEN_",",3.01,"E")
+9 SET NCAT=$$GET1^DIQ(90506.1,IEN_",",3.03,"E")
+10 SET NCLIN=$$GET1^DIQ(90506.1,IEN_",",3.02,"E")
+11 SET NVIEW=$$GET1^DIQ(90506.1,IEN_",",3.04,"I")
+12 SET PDIR=$$GET1^DIQ(90506.1,IEN_",",.14,"I")
+13 SET SIZE=$$GET1^DIQ(90506.1,IEN_",",.15,"E")
+14 SET EDIT=+$$GET1^DIQ(90506.1,IEN_",",.16,"I")
+15 SET EDIT=$SELECT(EDIT=1:"YES",1:"NO")
+16 SET BATCH=+$$GET1^DIQ(90506.1,IEN_",",.17,"I")
+17 SET BATCH=$SELECT(BATCH=1:"YES",1:"NO")
+18 SET SDIR=$$GET1^DIQ(90506.1,IEN_",",3.08,"I")
+19 IF SDIR=""
SET SDIR="A"
+20 SET VIEW=NVIEW
+21 IF VIEW=""
SET VIEW="O"
+22 SET DCLIN=""
+23 SET CAT=NCAT
+24 SET CLIN=NCLIN
+25 IF TTYPE="G"
Begin DoDot:1
+26 NEW CODE,BQIH,BQIYR,BQMEAS,VER
+27 SET CODE=$PIECE(FDATA,U,1)
SET YEAR=$PIECE(CODE,"_",1)
+28 SET BQMEAS=$PIECE(CODE,"_",2)
+29 SET BQIH=$$SPM^BQIGPUTL()
+30 SET BQIYR=$$LKP^BQIGPUTL(YEAR)
+31 SET VER=$$VERSION^XPDUTL("BGP")
+32 IF VER>7.0
Begin DoDot:2
+33 DO GFN^BQIGPUTL(BQIH,BQIYR)
+34 SET EXCEPT=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1704,"I")
+35 SET EXCEPT=$SELECT(EXCEPT="Y":"C",1:"N")
+36 SET PDIR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1705,"E")
End DoDot:2
End DoDot:1
+37 SET SCAT=$SELECT(CAT="":"@",1:CAT)
SET SCLIN=$SELECT(CLIN="":"@",1:CLIN)
+38 SET BQISORT(SRC,SCAT,SCLIN,$PIECE(FDATA,U,3),IEN)=IEN_U_SRC_U_CAT_U_CLIN_U_$PIECE(FDATA,U,3)_U_$PIECE(FDATA,U,1)_U_VIEW_U_$GET">GET(PDIR)_U_$GET">GET(EXCEPT)_U_SIZE_U_EDIT_U_BATCH_U_SDIR_$CHAR(30)
+39 ;S II=II+1,@DATA@(II)=IEN_U_SRC_U_CAT_U_CLIN_U_$P(FDATA,U,3)_U_$P(FDATA,U,1)_U_VIEW_U_PDIR_U_EXCEPT_U_SIZE_U_EDIT_U_BATCH_U_SDIR_$C(30)
+40 QUIT
+41 ;
CMGT ; Additional Care Mgmt columns
+1 NEW KEY,DXCL,FDATA,CAT,REQ,SRC,FTY,CLIN,SCLIN
+2 SET KEY=$PIECE(^BQI(90506.5,CMCOD,0),U,12)
+3 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+4 SET DXCL=0
+5 FOR
SET DXCL=$ORDER(^BQI(90506.5,CMCOD,10,DXCL))
IF 'DXCL
QUIT
Begin DoDot:1
+6 SET FDATA=^BQI(90506.5,CMCOD,10,DXCL,0)
+7 IF $PIECE(FDATA,U,9)=1
QUIT
+8 SET FTY=$PIECE(FDATA,U,2)
SET CAT=""
SET CLIN=""
SET SCLIN=""
+9 SET CAT=$PIECE($GET(^BQI(90506.5,CMCOD,10,DXCL,5)),"^",2)
SET CLIN=$PIECE($GET(^BQI(90506.5,CMCOD,10,DXCL,5)),"^",1)
+10 IF FTY'=""
Begin DoDot:2
+11 IF CAT'=""!(CLIN'="")
QUIT
+12 SET CAT=$$GET1^DIQ(90621.1,FTY_",",.07,"E")
+13 IF CAT="Other"
SET CLIN=$$GET1^DIQ(90621.1,FTY_",",.08,"E")
SET SCLIN=$$LOWER^VALM1(CLIN)
+14 ;I CLIN="" S CLIN="@",SCLIN=""
End DoDot:2
+15 SET REQ=$SELECT($PIECE(FDATA,U,6)'="":$PIECE(FDATA,U,6),1:"O")
+16 SET SCAT=$SELECT(CAT="":"@",1:CAT)
SET SCLIN=$SELECT(CLIN="":"@",1:CLIN)
+17 SET SRC=$SELECT($$GET1^DIQ(90506.5,CMCOD_",",.06,"E")'="":$$GET1^DIQ(90506.5,CMCOD_",",.06,"E"),1:$$GET1^DIQ(90506.5,CMCOD_",",.01,"E"))
+18 SET BQISORT(SRC,SCAT,SCLIN,$PIECE(FDATA,U,3),DXCL)=DXCL_U_SRC_U_CAT_U_CLIN_U_$PIECE(FDATA,U,3)_U_$PIECE(FDATA,U,1)_U_REQ_U_U_U_U_U_U_$CHAR(30)
+19 ;
End DoDot:1
+20 ;Get locally created care management columns if associated with a dx tag
+21 NEW DXTN
+22 SET DXTN=$PIECE($GET(^BQI(90506.5,CMCOD,0)),U,11)
IF DXTN=""
QUIT
+23 SET DXCL=0
+24 FOR
SET DXCL=$ORDER(^BQI(90506.2,DXTN,6,DXCL))
IF 'DXCL
QUIT
Begin DoDot:1
+25 SET CAT="Local"
SET CLIN=""
SET SCLIN=""
+26 SET FDATA=^BQI(90506.2,DXTN,6,DXCL,0)
+27 IF $PIECE(FDATA,U,9)=1
QUIT
+28 SET REQ=$SELECT($PIECE(FDATA,U,6)'="":$PIECE(FDATA,U,6),1:"O")
+29 SET SCAT=$SELECT(CAT="":"@",1:CAT)
SET SCLIN=$SELECT(CLIN="":"@",1:CLIN)
+30 SET SRC=$SELECT($$GET1^DIQ(90506.5,CMCOD_",",.06,"E")'="":$$GET1^DIQ(90506.5,CMCOD_",",.06,"E"),1:$$GET1^DIQ(90506.5,CMCOD_",",.01,"E"))
+31 SET BQISORT(SCAT,SCLIN,$PIECE(FDATA,U,3),DXCL)=DXCL_U_SRC_U_CAT_U_CLIN_U_$PIECE(FDATA,U,3)_U_$PIECE(FDATA,U,1)_U_REQ_U_U_U_U_U_U_$CHAR(30)
End DoDot:1
+32 QUIT
