- BQITRHLP ;VNGT/HS/ALA-Treatment Prompts Tooltips ; 23 Sep 2008 4:38 PM
- ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- ;
- EN(DATA,FAKE) ;EP - BQI GET TX PROMPT HELP
- NEW UID,II,TRIEN,CAT,TIT,SORT,RMK,REMARK,CT,NXT
- ;
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQITRHLP",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,4,RMK)) Q:'RMK D
- .. S REMARK=REMARK_^BQI(90508.5,TRIEN,4,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,13,RMK)) Q:'RMK D
- .. S REMARK=REMARK_^APCHSURV(TRIEN,13,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
- BQITRHLP ;VNGT/HS/ALA-Treatment Prompts Tooltips ; 23 Sep 2008 4:38 PM
- +1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- +2 ;
- EN(DATA,FAKE) ;EP - BQI GET TX PROMPT HELP
- +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("BQITRHLP",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,4,RMK))
- IF 'RMK
- QUIT
- Begin DoDot:2
- +20 SET REMARK=REMARK_^BQI(90508.5,TRIEN,4,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,13,RMK))
- IF 'RMK
- QUIT
- Begin DoDot:2
- +31 SET REMARK=REMARK_^APCHSURV(TRIEN,13,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
