BQIRMHLP ;PRXM/HC/ALA-Reminders Help ; 20 Feb 2007 2:15 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
GET(DATA,REM) ;EP -- BQI GET REMINDERS HELP TEXT
; Input
; REM - A reminder IEN if wanting the help text for a specific reminder
; otherwise if it is null, then retrieves the help text for all
; reminders
;
NEW UID,II,RIEN,BQIRM,REMNM,BQISORT
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIRMHLP",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRMHLP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S REM=$G(REM,"")
;
S BQIRM=$$FIND1^DIC(9001015,"","","ALL REMINDERS","B","","")
I 'BQIRM S BMXSEC="'ALL REMINDERS' Health Summary Type not found." Q
;
S @DATA@(II)="I00010MEAS_IEN^T00050REM_NAME^T00015CODE^T00030CATEGORY^T00030CLIN_GROUP^T00030STATUS^T01024REPORT_TEXT^T01024SUMM_LIST"_$C(30)
I REM'="" D GETDATA(REM) G DONE
S RIEN=0
F S RIEN=$O(^BQI(90506.1,"AC","R",RIEN)) Q:RIEN="" D
. I $$GET1^DIQ(90506.1,RIEN_",",.1,"I")=1 Q
. S REMNM=$P(^BQI(90506.1,RIEN,0),U,3)
. S BQISORT(REMNM,RIEN)=""
S REMNM=""
F S REMNM=$O(BQISORT(REMNM)) Q:REMNM="" D
. S RIEN=""
. F S RIEN=$O(BQISORT(REMNM,RIEN)) Q:RIEN="" D
.. D GETDATA(RIEN)
;
DONE ;
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
;
GETDATA(RIEN) ;EP - Get the reminder help text
NEW NAME,CODE,HIEN,IEN,CAT,CLIN,STATUS
S NAME=$P(^BQI(90506.1,RIEN,0),U,3),CODE=$P(^(0),U,1)
S CAT=$$GET1^DIQ(90506.1,RIEN_",",3.03,"E")
S CLIN=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
S HIEN=$P(CODE,"_",2)
I $P(CODE,"_",1)="AUTTIMM" D
. S NAME="IMMUNIZATIONS"
. S HIEN=$$FIND1^DIC(9001018,"","Q",NAME,"B","","ERROR")
I $P(CODE,"_",1)="COLO" D
. S NAME="COLORECTAL CA-SCOPE/XRAY"
. S HIEN=$$FIND1^DIC(9001018,"","Q",NAME,"B","","ERROR")
;
I $P(CODE,"_",1)="REG" D
. NEW DA,IENS
. S (DA(1),RGIEN)=$P(CODE,"_",2),(DA,HIEN)=$P(CODE,"_",3)
. S IENS=$$IENS^DILF(.DA)
. S NAME=$$GET1^DIQ(90507.015,IENS,.01,"E")
. S STATUS=$$GET1^DIQ(90507.015,IENS,.03,"E")
. S II=II+1,@DATA@(II)=RIEN_"^"_$P(^BQI(90506.1,RIEN,0),U,3)_"^"_CODE_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
. S IEN=0
. F S IEN=$O(^BQI(90507,RGIEN,15,HIEN,13,IEN)) Q:'IEN D
.. S II=II+1,@DATA@(II)=^BQI(90507,RGIEN,15,HIEN,13,IEN,0)_$C(10)
. S II=II+1,@DATA@(II)=U
;
I $P(CODE,"_",1)="CMET" D
. S STATUS=$S($P(^BQI(90506.1,RIEN,0),U,10)=1:"INACTIVE",1:"ACTIVE")
. S II=II+1,@DATA@(II)=RIEN_"^"_$P(^BQI(90506.1,RIEN,0),U,3)_"^"_CODE_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
. S IEN=0
. F S IEN=$O(^BQI(90506.1,RIEN,4,IEN)) Q:'IEN D
.. S II=II+1,@DATA@(II)=^BQI(90506.1,RIEN,4,IEN,0)_$C(10)
. S II=II+1,@DATA@(II)=U
;
I $P(CODE,"_",1)="EHR" D
. S STATUS=$S($P(^BQI(90506.1,RIEN,0),U,10)=1:"INACTIVE",1:"ACTIVE")
. S II=II+1,@DATA@(II)=RIEN_"^"_$P(^BQI(90506.1,RIEN,0),U,3)_"^"_CODE_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
. S IEN=0
. F S IEN=$O(^BQI(90506.1,RIEN,4,IEN)) Q:'IEN D
.. S II=II+1,@DATA@(II)=^BQI(90506.1,RIEN,4,IEN,0)_$C(10)
. S II=II+1,@DATA@(II)=U
;
I $P(CODE,"_",1)'="REG",$P(CODE,"_",1)'="CMET",$P(CODE,"_",1)'="EHR" D
. S STATUS=$$GET1^DIQ(9001018,HIEN_",",.03,"E")
. S II=II+1,@DATA@(II)=RIEN_"^"_$P(^BQI(90506.1,RIEN,0),U,3)_"^"_CODE_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
. S IEN=0
. F S IEN=$O(^APCHSURV(HIEN,13,IEN)) Q:'IEN D
.. S II=II+1,@DATA@(II)=^APCHSURV(HIEN,13,IEN,0)_$C(10)
. S IEN=0
. I $O(^APCHSURV(HIEN,11,0)) S II=II+1,@DATA@(II)="Currently Defined Criteria in Use at this Facility:"_$C(10)
. F S IEN=$O(^APCHSURV(HIEN,11,IEN)) Q:'IEN D
.. NEW DA,IENS,AIEN
.. S DA(1)=HIEN,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S II=II+1,@DATA@(II)=" Sex: "_$$GET1^DIQ(9001018.11,IENS,.01,"E")_$C(10)
.. S AIEN=0
.. F S AIEN=$O(^APCHSURV(HIEN,11,IEN,11,AIEN)) Q:'AIEN D
... NEW DA,IENS
... S DA(2)=HIEN,DA(1)=IEN,DA=AIEN,IENS=$$IENS^DILF(.DA)
... S II=II+1,@DATA@(II)=" Min. Age: "_$$GET1^DIQ(9001018.1111,IENS,.01,"E")_" Max. Age: "_$$GET1^DIQ(9001018.1111,IENS,.02,"E")_" Frequency: "_$$GET1^DIQ(9001018.1111,IENS,.03,"E")_$C(10)
. S II=II+1,@DATA@(II)="^"_$$SLST(HIEN)
S II=II+1,@DATA@(II)=$C(30)
Q
;
SLST(SHIEN) ; List of summaries that the reminder is on
NEW LIST,SIEN,SP
S SIEN=0,LIST=""
F S SIEN=$O(^APCHSCTL(SIEN)) Q:'SIEN D
. S SP=0
. F S SP=$O(^APCHSCTL(SIEN,5,SP)) Q:'SP D
.. I $P(^APCHSCTL(SIEN,5,SP,0),U,2)'=SHIEN Q
.. S LIST=LIST_$P(^APCHSCTL(SIEN,0),U,1)_$C(10)
S LIST=$$TKO^BQIUL1(LIST,$C(10))
Q LIST
;
GLS(DATA,FAKE) ; EP - BQI GET REMINDERS GLOSSARY
NEW UID,II,RIEN,BQIRM,REMNM,BQISORT
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIRMHLP",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRMHLP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S BQIRM=$$FIND1^DIC(9001015,"","","ALL REMINDERS","B","","")
I 'BQIRM S BMXSEC="'ALL REMINDERS' Health Summary Type not found." Q
;
S @DATA@(II)="T00050REM_NAME^T00050CATEGORY^T00050CLIN_GROUP^T00030STATUS^T02048REPORT_TEXT"_$C(30)
S RIEN=0
F S RIEN=$O(^BQI(90506.1,"AC","R",RIEN)) Q:RIEN="" D
. I $$GET1^DIQ(90506.1,RIEN_",",.1,"I")=1 Q
. S REMNM=$P(^BQI(90506.1,RIEN,0),U,3)
. S BQISORT(REMNM,RIEN)=""
S REMNM=""
F S REMNM=$O(BQISORT(REMNM)) Q:REMNM="" D
. S RIEN=""
. F S RIEN=$O(BQISORT(REMNM,RIEN)) Q:RIEN="" D
.. D GETGLS(RIEN)
S II=II+1,@DATA@(II)=$C(31)
Q
;
GETGLS(RIEN) ;EP - Get the reminder description
NEW NAME,CODE,HIEN,IEN,CAT,CLIN,STATUS
S NAME=$P(^BQI(90506.1,RIEN,0),U,3),CODE=$P(^(0),U,1)
S CAT=$$GET1^DIQ(90506.1,RIEN_",",3.03,"E")
S CLIN=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
S HIEN=$P(CODE,"_",2)
I $P(CODE,"_",1)="AUTTIMM" D
. S NAME="IMMUNIZATIONS"
. S HIEN=$$FIND1^DIC(9001018,"","Q",NAME,"B","","ERROR")
I $P(CODE,"_",1)="COLO" D
. S NAME="COLORECTAL CA-SCOPE/XRAY"
. S HIEN=$$FIND1^DIC(9001018,"","Q",NAME,"B","","ERROR")
;
I $P(CODE,"_",1)="REG" D
. NEW DA,IENS
. S (DA(1),RGIEN)=$P(CODE,"_",2),(DA,HIEN)=$P(CODE,"_",3)
. S IENS=$$IENS^DILF(.DA)
. S NAME=$$GET1^DIQ(90507.015,IENS,.01,"E")
. S STATUS=$$GET1^DIQ(90507.015,IENS,.03,"E")
. S II=II+1,@DATA@(II)=$P(^BQI(90506.1,RIEN,0),U,3)_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
. S IEN=0
. F S IEN=$O(^BQI(90507,RGIEN,15,HIEN,1,IEN)) Q:'IEN D
.. S II=II+1,@DATA@(II)=^BQI(90507,RGIEN,15,HIEN,1,IEN,0)_$C(10)
;
I $P(CODE,"_",1)="CMET" D
. S STATUS=$S($P(^BQI(90506.1,RIEN,0),U,10)=1:"INACTIVE",1:"ACTIVE")
. S II=II+1,@DATA@(II)=$P(^BQI(90506.1,RIEN,0),U,3)_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
. S IEN=0,II=II+1,@DATA@(II)="Category: "_CAT_$C(10)
. F S IEN=$O(^BQI(90506.1,RIEN,4,IEN)) Q:'IEN D
.. S II=II+1,@DATA@(II)=^BQI(90506.1,RIEN,4,IEN,0)_$C(10)
;
I $P(CODE,"_",1)="EHR" D
. S STATUS=$S($P(^BQI(90506.1,RIEN,0),U,10)=1:"INACTIVE",1:"ACTIVE")
. S II=II+1,@DATA@(II)=$P(^BQI(90506.1,RIEN,0),U,3)_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
. S IEN=0,II=II+1,@DATA@(II)="Category: "_CAT_$C(10)
. F S IEN=$O(^BQI(90506.1,RIEN,4,IEN)) Q:'IEN D
.. S II=II+1,@DATA@(II)=^BQI(90506.1,RIEN,4,IEN,0)_$C(10)
;
I $P(CODE,"_",1)'="REG",$P(CODE,"_",1)'="CMET",$P(CODE,"_",1)'="EHR" D
. S STATUS=$$GET1^DIQ(9001018,HIEN_",",.03,"E")
. S II=II+1,@DATA@(II)=$P(^BQI(90506.1,RIEN,0),U,3)_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
. S IEN=0,II=II+1,@DATA@(II)="Category: "_CAT_$C(10)
. F S IEN=$O(^APCHSURV(HIEN,1,IEN)) Q:'IEN D
.. S II=II+1,@DATA@(II)=^APCHSURV(HIEN,1,IEN,0)_$C(10)
. S IEN=0
. I $O(^APCHSURV(HIEN,11,0)) S II=II+1,@DATA@(II)="Currently Defined Criteria in Use at this Facility:"_$C(10)
. F S IEN=$O(^APCHSURV(HIEN,11,IEN)) Q:'IEN D
.. NEW DA,IENS,AIEN
.. S DA(1)=HIEN,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S II=II+1,@DATA@(II)=" Sex: "_$$GET1^DIQ(9001018.11,IENS,.01,"E")_$C(10)
.. S AIEN=0
.. F S AIEN=$O(^APCHSURV(HIEN,11,IEN,11,AIEN)) Q:'AIEN D
... NEW DA,IENS
... S DA(2)=HIEN,DA(1)=IEN,DA=AIEN,IENS=$$IENS^DILF(.DA)
... S II=II+1,@DATA@(II)=" Min. Age: "_$$GET1^DIQ(9001018.1111,IENS,.01,"E")_" Max. Age: "_$$GET1^DIQ(9001018.1111,IENS,.02,"E")_" Frequency: "_$$GET1^DIQ(9001018.1111,IENS,.03,"E")_$C(10)
S II=II+1,@DATA@(II)=$C(30)
Q
BQIRMHLP ;PRXM/HC/ALA-Reminders Help ; 20 Feb 2007 2:15 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
GET(DATA,REM) ;EP -- BQI GET REMINDERS HELP TEXT
+1 ; Input
+2 ; REM - A reminder IEN if wanting the help text for a specific reminder
+3 ; otherwise if it is null, then retrieves the help text for all
+4 ; reminders
+5 ;
+6 NEW UID,II,RIEN,BQIRM,REMNM,BQISORT
+7 ;
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 SET DATA=$NAME(^TMP("BQIRMHLP",UID))
+10 KILL @DATA
+11 ;
+12 SET II=0
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRMHLP D UNWIND^%ZTER"
+14 ;
+15 SET REM=$GET(REM,"")
+16 ;
+17 SET BQIRM=$$FIND1^DIC(9001015,"","","ALL REMINDERS","B","","")
+18 IF 'BQIRM
SET BMXSEC="'ALL REMINDERS' Health Summary Type not found."
QUIT
+19 ;
+20 SET @DATA@(II)="I00010MEAS_IEN^T00050REM_NAME^T00015CODE^T00030CATEGORY^T00030CLIN_GROUP^T00030STATUS^T01024REPORT_TEXT^T01024SUMM_LIST"_$CHAR(30)
+21 IF REM'=""
DO GETDATA(REM)
GOTO DONE
+22 SET RIEN=0
+23 FOR
SET RIEN=$ORDER(^BQI(90506.1,"AC","R",RIEN))
IF RIEN=""
QUIT
Begin DoDot:1
+24 IF $$GET1^DIQ(90506.1,RIEN_",",.1,"I")=1
QUIT
+25 SET REMNM=$PIECE(^BQI(90506.1,RIEN,0),U,3)
+26 SET BQISORT(REMNM,RIEN)=""
End DoDot:1
+27 SET REMNM=""
+28 FOR
SET REMNM=$ORDER(BQISORT(REMNM))
IF REMNM=""
QUIT
Begin DoDot:1
+29 SET RIEN=""
+30 FOR
SET RIEN=$ORDER(BQISORT(REMNM,RIEN))
IF RIEN=""
QUIT
Begin DoDot:2
+31 DO GETDATA(RIEN)
End DoDot:2
End DoDot:1
+32 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
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 ;
GETDATA(RIEN) ;EP - Get the reminder help text
+1 NEW NAME,CODE,HIEN,IEN,CAT,CLIN,STATUS
+2 SET NAME=$PIECE(^BQI(90506.1,RIEN,0),U,3)
SET CODE=$PIECE(^(0),U,1)
+3 SET CAT=$$GET1^DIQ(90506.1,RIEN_",",3.03,"E")
+4 SET CLIN=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
+5 SET HIEN=$PIECE(CODE,"_",2)
+6 IF $PIECE(CODE,"_",1)="AUTTIMM"
Begin DoDot:1
+7 SET NAME="IMMUNIZATIONS"
+8 SET HIEN=$$FIND1^DIC(9001018,"","Q",NAME,"B","","ERROR")
End DoDot:1
+9 IF $PIECE(CODE,"_",1)="COLO"
Begin DoDot:1
+10 SET NAME="COLORECTAL CA-SCOPE/XRAY"
+11 SET HIEN=$$FIND1^DIC(9001018,"","Q",NAME,"B","","ERROR")
End DoDot:1
+12 ;
+13 IF $PIECE(CODE,"_",1)="REG"
Begin DoDot:1
+14 NEW DA,IENS
+15 SET (DA(1),RGIEN)=$PIECE(CODE,"_",2)
SET (DA,HIEN)=$PIECE(CODE,"_",3)
+16 SET IENS=$$IENS^DILF(.DA)
+17 SET NAME=$$GET1^DIQ(90507.015,IENS,.01,"E")
+18 SET STATUS=$$GET1^DIQ(90507.015,IENS,.03,"E")
+19 SET II=II+1
SET @DATA@(II)=RIEN_"^"_$PIECE(^BQI(90506.1,RIEN,0),U,3)_"^"_CODE_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
+20 SET IEN=0
+21 FOR
SET IEN=$ORDER(^BQI(90507,RGIEN,15,HIEN,13,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+22 SET II=II+1
SET @DATA@(II)=^BQI(90507,RGIEN,15,HIEN,13,IEN,0)_$CHAR(10)
End DoDot:2
+23 SET II=II+1
SET @DATA@(II)=U
End DoDot:1
+24 ;
+25 IF $PIECE(CODE,"_",1)="CMET"
Begin DoDot:1
+26 SET STATUS=$SELECT($PIECE(^BQI(90506.1,RIEN,0),U,10)=1:"INACTIVE",1:"ACTIVE")
+27 SET II=II+1
SET @DATA@(II)=RIEN_"^"_$PIECE(^BQI(90506.1,RIEN,0),U,3)_"^"_CODE_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
+28 SET IEN=0
+29 FOR
SET IEN=$ORDER(^BQI(90506.1,RIEN,4,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+30 SET II=II+1
SET @DATA@(II)=^BQI(90506.1,RIEN,4,IEN,0)_$CHAR(10)
End DoDot:2
+31 SET II=II+1
SET @DATA@(II)=U
End DoDot:1
+32 ;
+33 IF $PIECE(CODE,"_",1)="EHR"
Begin DoDot:1
+34 SET STATUS=$SELECT($PIECE(^BQI(90506.1,RIEN,0),U,10)=1:"INACTIVE",1:"ACTIVE")
+35 SET II=II+1
SET @DATA@(II)=RIEN_"^"_$PIECE(^BQI(90506.1,RIEN,0),U,3)_"^"_CODE_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
+36 SET IEN=0
+37 FOR
SET IEN=$ORDER(^BQI(90506.1,RIEN,4,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+38 SET II=II+1
SET @DATA@(II)=^BQI(90506.1,RIEN,4,IEN,0)_$CHAR(10)
End DoDot:2
+39 SET II=II+1
SET @DATA@(II)=U
End DoDot:1
+40 ;
+41 IF $PIECE(CODE,"_",1)'="REG"
IF $PIECE(CODE,"_",1)'="CMET"
IF $PIECE(CODE,"_",1)'="EHR"
Begin DoDot:1
+42 SET STATUS=$$GET1^DIQ(9001018,HIEN_",",.03,"E")
+43 SET II=II+1
SET @DATA@(II)=RIEN_"^"_$PIECE(^BQI(90506.1,RIEN,0),U,3)_"^"_CODE_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
+44 SET IEN=0
+45 FOR
SET IEN=$ORDER(^APCHSURV(HIEN,13,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+46 SET II=II+1
SET @DATA@(II)=^APCHSURV(HIEN,13,IEN,0)_$CHAR(10)
End DoDot:2
+47 SET IEN=0
+48 IF $ORDER(^APCHSURV(HIEN,11,0))
SET II=II+1
SET @DATA@(II)="Currently Defined Criteria in Use at this Facility:"_$CHAR(10)
+49 FOR
SET IEN=$ORDER(^APCHSURV(HIEN,11,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+50 NEW DA,IENS,AIEN
+51 SET DA(1)=HIEN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+52 SET II=II+1
SET @DATA@(II)=" Sex: "_$$GET1^DIQ(9001018.11,IENS,.01,"E")_$CHAR(10)
+53 SET AIEN=0
+54 FOR
SET AIEN=$ORDER(^APCHSURV(HIEN,11,IEN,11,AIEN))
IF 'AIEN
QUIT
Begin DoDot:3
+55 NEW DA,IENS
+56 SET DA(2)=HIEN
SET DA(1)=IEN
SET DA=AIEN
SET IENS=$$IENS^DILF(.DA)
+57 SET II=II+1
SET @DATA@(II)=" Min. Age: "_$$GET1^DIQ(9001018.1111,IENS,.01,"E")_" Max. Age: "_$$GET1^DIQ(9001018.1111,IENS,.02,"E")_" Frequency: "_$$GET1^DIQ(9001018.1111,IENS,.03,"E")_$CHAR(10)
End DoDot:3
End DoDot:2
+58 SET II=II+1
SET @DATA@(II)="^"_$$SLST(HIEN)
End DoDot:1
+59 SET II=II+1
SET @DATA@(II)=$CHAR(30)
+60 QUIT
+61 ;
SLST(SHIEN) ; List of summaries that the reminder is on
+1 NEW LIST,SIEN,SP
+2 SET SIEN=0
SET LIST=""
+3 FOR
SET SIEN=$ORDER(^APCHSCTL(SIEN))
IF 'SIEN
QUIT
Begin DoDot:1
+4 SET SP=0
+5 FOR
SET SP=$ORDER(^APCHSCTL(SIEN,5,SP))
IF 'SP
QUIT
Begin DoDot:2
+6 IF $PIECE(^APCHSCTL(SIEN,5,SP,0),U,2)'=SHIEN
QUIT
+7 SET LIST=LIST_$PIECE(^APCHSCTL(SIEN,0),U,1)_$CHAR(10)
End DoDot:2
End DoDot:1
+8 SET LIST=$$TKO^BQIUL1(LIST,$CHAR(10))
+9 QUIT LIST
+10 ;
GLS(DATA,FAKE) ; EP - BQI GET REMINDERS GLOSSARY
+1 NEW UID,II,RIEN,BQIRM,REMNM,BQISORT
+2 ;
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQIRMHLP",UID))
+5 KILL @DATA
+6 ;
+7 SET II=0
+8 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRMHLP D UNWIND^%ZTER"
+9 ;
+10 SET BQIRM=$$FIND1^DIC(9001015,"","","ALL REMINDERS","B","","")
+11 IF 'BQIRM
SET BMXSEC="'ALL REMINDERS' Health Summary Type not found."
QUIT
+12 ;
+13 SET @DATA@(II)="T00050REM_NAME^T00050CATEGORY^T00050CLIN_GROUP^T00030STATUS^T02048REPORT_TEXT"_$CHAR(30)
+14 SET RIEN=0
+15 FOR
SET RIEN=$ORDER(^BQI(90506.1,"AC","R",RIEN))
IF RIEN=""
QUIT
Begin DoDot:1
+16 IF $$GET1^DIQ(90506.1,RIEN_",",.1,"I")=1
QUIT
+17 SET REMNM=$PIECE(^BQI(90506.1,RIEN,0),U,3)
+18 SET BQISORT(REMNM,RIEN)=""
End DoDot:1
+19 SET REMNM=""
+20 FOR
SET REMNM=$ORDER(BQISORT(REMNM))
IF REMNM=""
QUIT
Begin DoDot:1
+21 SET RIEN=""
+22 FOR
SET RIEN=$ORDER(BQISORT(REMNM,RIEN))
IF RIEN=""
QUIT
Begin DoDot:2
+23 DO GETGLS(RIEN)
End DoDot:2
End DoDot:1
+24 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+25 QUIT
+26 ;
GETGLS(RIEN) ;EP - Get the reminder description
+1 NEW NAME,CODE,HIEN,IEN,CAT,CLIN,STATUS
+2 SET NAME=$PIECE(^BQI(90506.1,RIEN,0),U,3)
SET CODE=$PIECE(^(0),U,1)
+3 SET CAT=$$GET1^DIQ(90506.1,RIEN_",",3.03,"E")
+4 SET CLIN=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
+5 SET HIEN=$PIECE(CODE,"_",2)
+6 IF $PIECE(CODE,"_",1)="AUTTIMM"
Begin DoDot:1
+7 SET NAME="IMMUNIZATIONS"
+8 SET HIEN=$$FIND1^DIC(9001018,"","Q",NAME,"B","","ERROR")
End DoDot:1
+9 IF $PIECE(CODE,"_",1)="COLO"
Begin DoDot:1
+10 SET NAME="COLORECTAL CA-SCOPE/XRAY"
+11 SET HIEN=$$FIND1^DIC(9001018,"","Q",NAME,"B","","ERROR")
End DoDot:1
+12 ;
+13 IF $PIECE(CODE,"_",1)="REG"
Begin DoDot:1
+14 NEW DA,IENS
+15 SET (DA(1),RGIEN)=$PIECE(CODE,"_",2)
SET (DA,HIEN)=$PIECE(CODE,"_",3)
+16 SET IENS=$$IENS^DILF(.DA)
+17 SET NAME=$$GET1^DIQ(90507.015,IENS,.01,"E")
+18 SET STATUS=$$GET1^DIQ(90507.015,IENS,.03,"E")
+19 SET II=II+1
SET @DATA@(II)=$PIECE(^BQI(90506.1,RIEN,0),U,3)_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
+20 SET IEN=0
+21 FOR
SET IEN=$ORDER(^BQI(90507,RGIEN,15,HIEN,1,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+22 SET II=II+1
SET @DATA@(II)=^BQI(90507,RGIEN,15,HIEN,1,IEN,0)_$CHAR(10)
End DoDot:2
End DoDot:1
+23 ;
+24 IF $PIECE(CODE,"_",1)="CMET"
Begin DoDot:1
+25 SET STATUS=$SELECT($PIECE(^BQI(90506.1,RIEN,0),U,10)=1:"INACTIVE",1:"ACTIVE")
+26 SET II=II+1
SET @DATA@(II)=$PIECE(^BQI(90506.1,RIEN,0),U,3)_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
+27 SET IEN=0
SET II=II+1
SET @DATA@(II)="Category: "_CAT_$CHAR(10)
+28 FOR
SET IEN=$ORDER(^BQI(90506.1,RIEN,4,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+29 SET II=II+1
SET @DATA@(II)=^BQI(90506.1,RIEN,4,IEN,0)_$CHAR(10)
End DoDot:2
End DoDot:1
+30 ;
+31 IF $PIECE(CODE,"_",1)="EHR"
Begin DoDot:1
+32 SET STATUS=$SELECT($PIECE(^BQI(90506.1,RIEN,0),U,10)=1:"INACTIVE",1:"ACTIVE")
+33 SET II=II+1
SET @DATA@(II)=$PIECE(^BQI(90506.1,RIEN,0),U,3)_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
+34 SET IEN=0
SET II=II+1
SET @DATA@(II)="Category: "_CAT_$CHAR(10)
+35 FOR
SET IEN=$ORDER(^BQI(90506.1,RIEN,4,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+36 SET II=II+1
SET @DATA@(II)=^BQI(90506.1,RIEN,4,IEN,0)_$CHAR(10)
End DoDot:2
End DoDot:1
+37 ;
+38 IF $PIECE(CODE,"_",1)'="REG"
IF $PIECE(CODE,"_",1)'="CMET"
IF $PIECE(CODE,"_",1)'="EHR"
Begin DoDot:1
+39 SET STATUS=$$GET1^DIQ(9001018,HIEN_",",.03,"E")
+40 SET II=II+1
SET @DATA@(II)=$PIECE(^BQI(90506.1,RIEN,0),U,3)_"^"_CAT_"^"_CLIN_"^"_STATUS_"^"
+41 SET IEN=0
SET II=II+1
SET @DATA@(II)="Category: "_CAT_$CHAR(10)
+42 FOR
SET IEN=$ORDER(^APCHSURV(HIEN,1,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+43 SET II=II+1
SET @DATA@(II)=^APCHSURV(HIEN,1,IEN,0)_$CHAR(10)
End DoDot:2
+44 SET IEN=0
+45 IF $ORDER(^APCHSURV(HIEN,11,0))
SET II=II+1
SET @DATA@(II)="Currently Defined Criteria in Use at this Facility:"_$CHAR(10)
+46 FOR
SET IEN=$ORDER(^APCHSURV(HIEN,11,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+47 NEW DA,IENS,AIEN
+48 SET DA(1)=HIEN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+49 SET II=II+1
SET @DATA@(II)=" Sex: "_$$GET1^DIQ(9001018.11,IENS,.01,"E")_$CHAR(10)
+50 SET AIEN=0
+51 FOR
SET AIEN=$ORDER(^APCHSURV(HIEN,11,IEN,11,AIEN))
IF 'AIEN
QUIT
Begin DoDot:3
+52 NEW DA,IENS
+53 SET DA(2)=HIEN
SET DA(1)=IEN
SET DA=AIEN
SET IENS=$$IENS^DILF(.DA)
+54 SET II=II+1
SET @DATA@(II)=" Min. Age: "_$$GET1^DIQ(9001018.1111,IENS,.01,"E")_" Max. Age: "_$$GET1^DIQ(9001018.1111,IENS,.02,"E")_" Frequency: "_$$GET1^DIQ(9001018.1111,IENS,.03,"E")_$CHAR(10)
End DoDot:3
End DoDot:2
End DoDot:1
+55 SET II=II+1
SET @DATA@(II)=$CHAR(30)
+56 QUIT
