BQIRMRHL ;PRXM/HC/ALA-Register Reminders Help ; 01 Nov 2007 5:45 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
EN(DATA,REG) ;EP -- BQI REG REMIND HELP
;Description - Entry point for the panel
NEW UID,II,X,BQIRM,VAL,DFN,HIEN,E,J,K,L,MAX,MIN,NAFLG,STVWCD,RGIEN
NEW CODE,NCODE,RMIEN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIRMRHL",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRMRHL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S REG=$G(REG,"")
S @DATA@(II)="I00010MEAS_IEN^T00050REM_NAME^T00015CODE^T00030CATEGORY^T00030CLIN_GROUP^T01024REPORT_TEXT"_$C(30)
;
I $G(REG)'="" D Q:$G(BMXSEC)'=""
. S RGIEN=$O(^BQI(90507,"B",REG,""))
. I RGIEN="" S BMXSEC=REG_" not a valid register name" Q
. D RGRM(RGIEN)
;
I $G(REG)="" D
. S RGIEN=0
. F S RGIEN=$O(^BQI(90507,RGIEN)) Q:'RGIEN D
.. I $P(^BQI(90507,RGIEN,0),U,8)=1 Q
.. D RGRM(RGIEN)
;
S RGIEN=""
F S RGIEN=$O(BQISORT(RGIEN)) Q:RGIEN="" D
. S REMNM=""
. F S REMNM=$O(BQISORT(RGIEN,REMNM)) Q:REMNM="" D
.. S IEN=""
.. F S IEN=$O(BQISORT(RGIEN,REMNM,IEN)) Q:IEN="" D
... S RMIEN=BQISORT(RGIEN,REMNM,IEN)
... D GETDATA(RGIEN,RMIEN,IEN)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
RGRM(RGIEN) ;
S NCODE="REG_"_RGIEN
S RMIEN=0
F S RMIEN=$O(^BQI(90507,RGIEN,15,RMIEN)) Q:'RMIEN D
. S CODE=NCODE_"_"_RMIEN
. S IEN=""
. F S IEN=$O(^BQI(90506.1,"B",CODE,IEN)) Q:IEN="" D
.. S REMNM=$P(^BQI(90506.1,IEN,0),U,3)
.. S BQISORT(RGIEN,REMNM,IEN)=RMIEN
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(RGIEN,RMIEN,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_",",2.03,"E")
;S CLIN=$$GET1^DIQ(90506.1,RIEN_",",2.05,"E")
S CAT=$$GET1^DIQ(90506.1,RIEN_",",3.03,"E")
S CLIN=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
S TXIEN=0,TEXT=""
F S TXIEN=$O(^BQI(90507,RGIEN,15,RMIEN,13,TXIEN)) Q:'TXIEN D
. S TEXT=TEXT_^BQI(90507,RGIEN,15,RMIEN,13,TXIEN,0)_$C(10)
S TEXT=$$TKO^BQIUL1(TEXT,$C(10))
S II=II+1,@DATA@(II)=RIEN_"^"_$P(^BQI(90506.1,RIEN,0),U,3)_"^"_CODE_"^"_CAT_"^"_CLIN_"^"_TEXT_$C(30)
Q
BQIRMRHL ;PRXM/HC/ALA-Register Reminders Help ; 01 Nov 2007 5:45 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
EN(DATA,REG) ;EP -- BQI REG REMIND HELP
+1 ;Description - Entry point for the panel
+2 NEW UID,II,X,BQIRM,VAL,DFN,HIEN,E,J,K,L,MAX,MIN,NAFLG,STVWCD,RGIEN
+3 NEW CODE,NCODE,RMIEN
+4 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+5 SET DATA=$NAME(^TMP("BQIRMRHL",UID))
+6 KILL @DATA
+7 ;
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRMRHL D UNWIND^%ZTER"
+10 ;
+11 SET REG=$GET(REG,"")
+12 SET @DATA@(II)="I00010MEAS_IEN^T00050REM_NAME^T00015CODE^T00030CATEGORY^T00030CLIN_GROUP^T01024REPORT_TEXT"_$CHAR(30)
+13 ;
+14 IF $GET(REG)'=""
Begin DoDot:1
+15 SET RGIEN=$ORDER(^BQI(90507,"B",REG,""))
+16 IF RGIEN=""
SET BMXSEC=REG_" not a valid register name"
QUIT
+17 DO RGRM(RGIEN)
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+18 ;
+19 IF $GET(REG)=""
Begin DoDot:1
+20 SET RGIEN=0
+21 FOR
SET RGIEN=$ORDER(^BQI(90507,RGIEN))
IF 'RGIEN
QUIT
Begin DoDot:2
+22 IF $PIECE(^BQI(90507,RGIEN,0),U,8)=1
QUIT
+23 DO RGRM(RGIEN)
End DoDot:2
End DoDot:1
+24 ;
+25 SET RGIEN=""
+26 FOR
SET RGIEN=$ORDER(BQISORT(RGIEN))
IF RGIEN=""
QUIT
Begin DoDot:1
+27 SET REMNM=""
+28 FOR
SET REMNM=$ORDER(BQISORT(RGIEN,REMNM))
IF REMNM=""
QUIT
Begin DoDot:2
+29 SET IEN=""
+30 FOR
SET IEN=$ORDER(BQISORT(RGIEN,REMNM,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+31 SET RMIEN=BQISORT(RGIEN,REMNM,IEN)
+32 DO GETDATA(RGIEN,RMIEN,IEN)
End DoDot:3
End DoDot:2
End DoDot:1
+33 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
RGRM(RGIEN) ;
+1 SET NCODE="REG_"_RGIEN
+2 SET RMIEN=0
+3 FOR
SET RMIEN=$ORDER(^BQI(90507,RGIEN,15,RMIEN))
IF 'RMIEN
QUIT
Begin DoDot:1
+4 SET CODE=NCODE_"_"_RMIEN
+5 SET IEN=""
+6 FOR
SET IEN=$ORDER(^BQI(90506.1,"B",CODE,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+7 SET REMNM=$PIECE(^BQI(90506.1,IEN,0),U,3)
+8 SET BQISORT(RGIEN,REMNM,IEN)=RMIEN
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
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(RGIEN,RMIEN,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 ;S CAT=$$GET1^DIQ(90506.1,RIEN_",",2.03,"E")
+4 ;S CLIN=$$GET1^DIQ(90506.1,RIEN_",",2.05,"E")
+5 SET CAT=$$GET1^DIQ(90506.1,RIEN_",",3.03,"E")
+6 SET CLIN=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
+7 SET TXIEN=0
SET TEXT=""
+8 FOR
SET TXIEN=$ORDER(^BQI(90507,RGIEN,15,RMIEN,13,TXIEN))
IF 'TXIEN
QUIT
Begin DoDot:1
+9 SET TEXT=TEXT_^BQI(90507,RGIEN,15,RMIEN,13,TXIEN,0)_$CHAR(10)
End DoDot:1
+10 SET TEXT=$$TKO^BQIUL1(TEXT,$CHAR(10))
+11 SET II=II+1
SET @DATA@(II)=RIEN_"^"_$PIECE(^BQI(90506.1,RIEN,0),U,3)_"^"_CODE_"^"_CAT_"^"_CLIN_"^"_TEXT_$CHAR(30)
+12 QUIT
