BQITRGLS ;VNGT/HS/ALA-Treatment Prompt Glossary ; 16 Sep 2008 3:04 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
GLS(DATA,FAKE) ;EP - BQI GET TX PROMPT GLOSSARY
NEW UID,II,TRIEN,CAT,TIT,SORT,RMK,REMARK,CT,NXT
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQITRGLS",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITRHLP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00030CATEGORY^T00030PROMPT^T01024REPORT_TEXT"_$C(30)
S TRIEN=0,CAT="CVD-RELATED"
F S TRIEN=$O(^BQI(90508.5,TRIEN)) Q:'TRIEN D
. I $P(^BQI(90508.5,TRIEN,0),U,4)=1 Q
. S TIT=$$GET1^DIQ(90508.5,TRIEN_",",.01,"E")
. ; If the treatment prompt has been added to APCHSURV, quit, it will print
. ; below
. I $O(^APCHSURV("B",TIT,""))'="" Q
. S RMK=0,REMARK=""
. F S RMK=$O(^BQI(90508.5,TRIEN,3,RMK)) Q:'RMK D
.. S REMARK=REMARK_^BQI(90508.5,TRIEN,3,RMK,0)_$C(10)
. S REMARK=$$TKO^BQIUL1(REMARK,$C(10))
. S SORT(CAT,TRIEN)=CAT_U_TIT_U_REMARK_$C(30)
S TRIEN=0
F S TRIEN=$O(^APCHSURV(TRIEN)) Q:'TRIEN D
. I $P(^APCHSURV(TRIEN,0),U,7)'="T" Q
. I $P(^APCHSURV(TRIEN,0),U,3)'=1 Q
. S CAT=$$GET1^DIQ(9001018,TRIEN_",",.05,"E")
. S TIT=$$GET1^DIQ(9001018,TRIEN_",",.01,"E")
. S RMK=0,REMARK=""
. F S RMK=$O(^APCHSURV(TRIEN,1,RMK)) Q:'RMK D
.. S REMARK=REMARK_^APCHSURV(TRIEN,1,RMK,0)_$C(10)
. S REMARK=$$TKO^BQIUL1(REMARK,$C(10))
. S SORT(CAT,TIT)=CAT_U_TIT_U_REMARK_$C(30)
;
S CT=""
F S CT=$O(SORT(CT)) Q:CT="" D
. S NXT=""
. F S NXT=$O(SORT(CT,NXT)) Q:NXT="" D
.. S II=II+1,@DATA@(II)=SORT(CT,NXT)
S II=II+1,@DATA@(II)=$C(31)
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
BQITRGLS ;VNGT/HS/ALA-Treatment Prompt Glossary ; 16 Sep 2008 3:04 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
GLS(DATA,FAKE) ;EP - BQI GET TX PROMPT GLOSSARY
+1 NEW UID,II,TRIEN,CAT,TIT,SORT,RMK,REMARK,CT,NXT
+2 ;
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQITRGLS",UID))
+5 KILL @DATA
+6 ;
+7 SET II=0
+8 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITRHLP D UNWIND^%ZTER"
+9 ;
+10 SET @DATA@(II)="T00030CATEGORY^T00030PROMPT^T01024REPORT_TEXT"_$CHAR(30)
+11 SET TRIEN=0
SET CAT="CVD-RELATED"
+12 FOR
SET TRIEN=$ORDER(^BQI(90508.5,TRIEN))
IF 'TRIEN
QUIT
Begin DoDot:1
+13 IF $PIECE(^BQI(90508.5,TRIEN,0),U,4)=1
QUIT
+14 SET TIT=$$GET1^DIQ(90508.5,TRIEN_",",.01,"E")
+15 ; If the treatment prompt has been added to APCHSURV, quit, it will print
+16 ; below
+17 IF $ORDER(^APCHSURV("B",TIT,""))'=""
QUIT
+18 SET RMK=0
SET REMARK=""
+19 FOR
SET RMK=$ORDER(^BQI(90508.5,TRIEN,3,RMK))
IF 'RMK
QUIT
Begin DoDot:2
+20 SET REMARK=REMARK_^BQI(90508.5,TRIEN,3,RMK,0)_$CHAR(10)
End DoDot:2
+21 SET REMARK=$$TKO^BQIUL1(REMARK,$CHAR(10))
+22 SET SORT(CAT,TRIEN)=CAT_U_TIT_U_REMARK_$CHAR(30)
End DoDot:1
+23 SET TRIEN=0
+24 FOR
SET TRIEN=$ORDER(^APCHSURV(TRIEN))
IF 'TRIEN
QUIT
Begin DoDot:1
+25 IF $PIECE(^APCHSURV(TRIEN,0),U,7)'="T"
QUIT
+26 IF $PIECE(^APCHSURV(TRIEN,0),U,3)'=1
QUIT
+27 SET CAT=$$GET1^DIQ(9001018,TRIEN_",",.05,"E")
+28 SET TIT=$$GET1^DIQ(9001018,TRIEN_",",.01,"E")
+29 SET RMK=0
SET REMARK=""
+30 FOR
SET RMK=$ORDER(^APCHSURV(TRIEN,1,RMK))
IF 'RMK
QUIT
Begin DoDot:2
+31 SET REMARK=REMARK_^APCHSURV(TRIEN,1,RMK,0)_$CHAR(10)
End DoDot:2
+32 SET REMARK=$$TKO^BQIUL1(REMARK,$CHAR(10))
+33 SET SORT(CAT,TIT)=CAT_U_TIT_U_REMARK_$CHAR(30)
End DoDot:1
+34 ;
+35 SET CT=""
+36 FOR
SET CT=$ORDER(SORT(CT))
IF CT=""
QUIT
Begin DoDot:1
+37 SET NXT=""
+38 FOR
SET NXT=$ORDER(SORT(CT,NXT))
IF NXT=""
QUIT
Begin DoDot:2
+39 SET II=II+1
SET @DATA@(II)=SORT(CT,NXT)
End DoDot:2
End DoDot:1
+40 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+41 QUIT
+42 ;
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
