BQICMHLP ;VNGT/HS/ALA-Care Mgmt Help ; 15 Apr 2009 3:57 PM
;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
;
EN(DATA,TYPE) ; EP -- BQI GET CARE MGMT HELP TEXT
; Input
; TYPE - type of measures to list see table 90506.5 for list
;
NEW UID,II,CMCOD,CODE,IEN,ORD,TTYPE,AVHELP
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQICMHLP",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)="T00050CARE^T00015CODE^T01024REPORT_TEXT"_$C(30)
S TYPE=$G(TYPE,"")
I TYPE'="" D G DONE
. I TYPE'?.N S CMCOD=$$FIND1^DIC(90506.5,"","B",TYPE,"","","ERROR")
. I TYPE?.N S CMCOD=TYPE
. ;
. 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
. D RET
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
RET ;
; Check for Alternate Display Order first
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 GETDATA(IEN)
;
; Check for normal display 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 GETDATA(IEN)
;
; Check for site-populated fields
D CMGT
Q
;
CMGT ; Additional Care Mgmt columns
NEW KEY,DXCL,FDATA,CAT,REQ,SRC
S KEY=$P(^BQI(90506.5,CMCOD,0),U,12)
I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
S TYPE=$P(^BQI(90506.5,CMCOD,0),U,1)
S DXCL=0
F S DXCL=$O(^BQI(90506.5,CMCOD,10,DXCL)) Q:'DXCL D
. S CODE=$P(^BQI(90506.5,CMCOD,10,DXCL,0),U,1)
. S VHELP="",VN=0
. F S VN=$O(^BQI(90506.5,CMCOD,10,DXCL,4,VN)) Q:'VN D
.. S VHELP=VHELP_^BQI(90506.5,CMCOD,10,DXCL,4,VN,0)_$C(10)
. ;
. S VHELP=$$TKO^BQIUL1(VHELP,$C(10))
. I $G(AVHELP)'="" S VHELP=AVHELP
. ;
. S II=II+1,@DATA@(II)=TYPE_U_CODE_U_VHELP_$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 CODE=$P(^BQI(90506.2,DXTN,6,DXCL,0),U,1)
. S VHELP="",VN=0
. F S VN=$O(^BQI(90506.2,DXTN,6,DXCL,4,VN)) Q:'VN D
.. S VHELP=VHELP_^BQI(90506.2,DXTN,6,DXCL,4,VN,0)_$C(10)
. ;
. S VHELP=$$TKO^BQIUL1(VHELP,$C(10))
. I $G(AVHELP)'="" S VHELP=AVHELP
. ;
. S II=II+1,@DATA@(II)=TYPE_U_CODE_U_VHELP_$C(30)
Q
;
GETDATA(RIEN) ;EP - Get the reminder help text
NEW VHELP,FILE,FIELD,NAME,BQIHELPW,BN,VN,KEY
I $$GET1^DIQ(90506.1,RIEN_",",.1,"I")=1 Q
S KEY=$$GET1^DIQ(90506.1,RIEN_",",3.1,"E")
I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
S TYPE=$$GET1^DIQ(90506.1,RIEN_",",3.01,"E")
S CODE=$P(^BQI(90506.1,RIEN,0),U,1) I CODE="" Q
S VHELP="",VN=0
F S VN=$O(^BQI(90506.1,RIEN,4,VN)) Q:'VN D
. S VHELP=VHELP_^BQI(90506.1,RIEN,4,VN,0)_$C(10)
;
S VHELP=$$TKO^BQIUL1(VHELP,$C(10))
I $G(AVHELP)'="" S VHELP=AVHELP
;
S II=II+1,@DATA@(II)=TYPE_U_CODE_U_VHELP_$C(30)
Q
BQICMHLP ;VNGT/HS/ALA-Care Mgmt Help ; 15 Apr 2009 3:57 PM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
+2 ;
EN(DATA,TYPE) ; EP -- BQI GET CARE MGMT HELP TEXT
+1 ; Input
+2 ; TYPE - type of measures to list see table 90506.5 for list
+3 ;
+4 NEW UID,II,CMCOD,CODE,IEN,ORD,TTYPE,AVHELP
+5 ;
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("BQICMHLP",UID))
+8 KILL @DATA
+9 ;
+10 SET II=0
+11 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQICMLST D UNWIND^%ZTER"
+12 ;
+13 SET @DATA@(II)="T00050CARE^T00015CODE^T01024REPORT_TEXT"_$CHAR(30)
+14 SET TYPE=$GET(TYPE,"")
+15 IF TYPE'=""
Begin DoDot:1
+16 IF TYPE'?.N
SET CMCOD=$$FIND1^DIC(90506.5,"","B",TYPE,"","","ERROR")
+17 IF TYPE?.N
SET CMCOD=TYPE
+18 ;
+19 SET TTYPE=$PIECE($GET(^BQI(90506.5,CMCOD,0)),U,2)
+20 IF TTYPE'=""
DO RET
+21 ;
+22 ;Get care management columns
+23 DO CMGT
End DoDot:1
GOTO DONE
+24 ;
+25 SET TTYPE=""
+26 FOR
SET TTYPE=$ORDER(^BQI(90506.5,"C",TTYPE))
IF TTYPE=""
QUIT
Begin DoDot:1
+27 SET CMCOD=$ORDER(^BQI(90506.5,"C",TTYPE,""))
+28 SET INACTIVE=$$GET1^DIQ(90506.5,CMCOD_",",.1,"I")
IF INACTIVE
QUIT
+29 SET IEN=$ORDER(^BQI(90506.1,"AD",TTYPE,""))
+30 IF IEN=""
DO CMGT
QUIT
+31 DO RET
End DoDot:1
+32 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
RET ;
+1 ; Check for Alternate Display Order first
+2 SET ORD=""
+3 FOR
SET ORD=$ORDER(^BQI(90506.1,"AF",TTYPE,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+4 SET IEN=""
+5 FOR
SET IEN=$ORDER(^BQI(90506.1,"AF",TTYPE,ORD,IEN))
IF IEN=""
QUIT
DO GETDATA(IEN)
End DoDot:1
+6 ;
+7 ; Check for normal display order
+8 SET ORD=""
+9 FOR
SET ORD=$ORDER(^BQI(90506.1,"AD",TTYPE,ORD))
IF ORD=""
QUIT
Begin DoDot:1
+10 SET IEN=""
+11 FOR
SET IEN=$ORDER(^BQI(90506.1,"AD",TTYPE,ORD,IEN))
IF IEN=""
QUIT
DO GETDATA(IEN)
End DoDot:1
+12 ;
+13 ; Check for site-populated fields
+14 DO CMGT
+15 QUIT
+16 ;
CMGT ; Additional Care Mgmt columns
+1 NEW KEY,DXCL,FDATA,CAT,REQ,SRC
+2 SET KEY=$PIECE(^BQI(90506.5,CMCOD,0),U,12)
+3 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+4 SET TYPE=$PIECE(^BQI(90506.5,CMCOD,0),U,1)
+5 SET DXCL=0
+6 FOR
SET DXCL=$ORDER(^BQI(90506.5,CMCOD,10,DXCL))
IF 'DXCL
QUIT
Begin DoDot:1
+7 SET CODE=$PIECE(^BQI(90506.5,CMCOD,10,DXCL,0),U,1)
+8 SET VHELP=""
SET VN=0
+9 FOR
SET VN=$ORDER(^BQI(90506.5,CMCOD,10,DXCL,4,VN))
IF 'VN
QUIT
Begin DoDot:2
+10 SET VHELP=VHELP_^BQI(90506.5,CMCOD,10,DXCL,4,VN,0)_$CHAR(10)
End DoDot:2
+11 ;
+12 SET VHELP=$$TKO^BQIUL1(VHELP,$CHAR(10))
+13 IF $GET(AVHELP)'=""
SET VHELP=AVHELP
+14 ;
+15 SET II=II+1
SET @DATA@(II)=TYPE_U_CODE_U_VHELP_$CHAR(30)
+16 ;
End DoDot:1
+17 ;Get locally created care management columns if associated with a dx tag
+18 NEW DXTN
+19 SET DXTN=$PIECE($GET(^BQI(90506.5,CMCOD,0)),U,11)
IF DXTN=""
QUIT
+20 SET DXCL=0
+21 FOR
SET DXCL=$ORDER(^BQI(90506.2,DXTN,6,DXCL))
IF 'DXCL
QUIT
Begin DoDot:1
+22 SET CODE=$PIECE(^BQI(90506.2,DXTN,6,DXCL,0),U,1)
+23 SET VHELP=""
SET VN=0
+24 FOR
SET VN=$ORDER(^BQI(90506.2,DXTN,6,DXCL,4,VN))
IF 'VN
QUIT
Begin DoDot:2
+25 SET VHELP=VHELP_^BQI(90506.2,DXTN,6,DXCL,4,VN,0)_$CHAR(10)
End DoDot:2
+26 ;
+27 SET VHELP=$$TKO^BQIUL1(VHELP,$CHAR(10))
+28 IF $GET(AVHELP)'=""
SET VHELP=AVHELP
+29 ;
+30 SET II=II+1
SET @DATA@(II)=TYPE_U_CODE_U_VHELP_$CHAR(30)
End DoDot:1
+31 QUIT
+32 ;
GETDATA(RIEN) ;EP - Get the reminder help text
+1 NEW VHELP,FILE,FIELD,NAME,BQIHELPW,BN,VN,KEY
+2 IF $$GET1^DIQ(90506.1,RIEN_",",.1,"I")=1
QUIT
+3 SET KEY=$$GET1^DIQ(90506.1,RIEN_",",3.1,"E")
+4 IF KEY'=""
IF '$$KEYCHK^BQIULSC(KEY,DUZ)
QUIT
+5 SET TYPE=$$GET1^DIQ(90506.1,RIEN_",",3.01,"E")
+6 SET CODE=$PIECE(^BQI(90506.1,RIEN,0),U,1)
IF CODE=""
QUIT
+7 SET VHELP=""
SET VN=0
+8 FOR
SET VN=$ORDER(^BQI(90506.1,RIEN,4,VN))
IF 'VN
QUIT
Begin DoDot:1
+9 SET VHELP=VHELP_^BQI(90506.1,RIEN,4,VN,0)_$CHAR(10)
End DoDot:1
+10 ;
+11 SET VHELP=$$TKO^BQIUL1(VHELP,$CHAR(10))
+12 IF $GET(AVHELP)'=""
SET VHELP=AVHELP
+13 ;
+14 SET II=II+1
SET @DATA@(II)=TYPE_U_CODE_U_VHELP_$CHAR(30)
+15 QUIT