Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQIRMRHL

BQIRMRHL.m

Go to the documentation of this file. 
  1. BQIRMRHL ;PRXM/HC/ALA-Register Reminders Help ; 01 Nov 2007  5:45 PM
  1.  ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1.  Q
  1.  ;
  1. EN(DATA,REG) ;EP -- BQI REG REMIND HELP
  1.  ;Description - Entry point for the panel
  1.  NEW UID,II,X,BQIRM,VAL,DFN,HIEN,E,J,K,L,MAX,MIN,NAFLG,STVWCD,RGIEN
  1.  NEW CODE,NCODE,RMIEN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIRMRHL",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRMRHL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S REG=$G(REG,"")
  1.  S @DATA@(II)="I00010MEAS_IEN^T00050REM_NAME^T00015CODE^T00030CATEGORY^T00030CLIN_GROUP^T01024REPORT_TEXT"_$C(30)
  1.  ;
  1.  I $G(REG)'="" D  Q:$G(BMXSEC)'=""
  1.  . S RGIEN=$O(^BQI(90507,"B",REG,""))
  1.  . I RGIEN="" S BMXSEC=REG_" not a valid register name" Q
  1.  . D RGRM(RGIEN)
  1.  ;
  1.  I $G(REG)="" D
  1.  . S RGIEN=0
  1.  . F  S RGIEN=$O(^BQI(90507,RGIEN)) Q:'RGIEN  D
  1.  .. I $P(^BQI(90507,RGIEN,0),U,8)=1 Q
  1.  .. D RGRM(RGIEN)
  1.  ;
  1.  S RGIEN=""
  1.  F  S RGIEN=$O(BQISORT(RGIEN)) Q:RGIEN=""  D
  1.  . S REMNM=""
  1.  . F  S REMNM=$O(BQISORT(RGIEN,REMNM)) Q:REMNM=""  D
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(BQISORT(RGIEN,REMNM,IEN)) Q:IEN=""  D
  1.  ... S RMIEN=BQISORT(RGIEN,REMNM,IEN)
  1.  ... D GETDATA(RGIEN,RMIEN,IEN)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. RGRM(RGIEN) ;
  1.  S NCODE="REG_"_RGIEN
  1.  S RMIEN=0
  1.  F  S RMIEN=$O(^BQI(90507,RGIEN,15,RMIEN)) Q:'RMIEN  D
  1.  . S CODE=NCODE_"_"_RMIEN
  1.  . S IEN=""
  1.  . F  S IEN=$O(^BQI(90506.1,"B",CODE,IEN)) Q:IEN=""  D
  1.  .. S REMNM=$P(^BQI(90506.1,IEN,0),U,3)
  1.  .. S BQISORT(RGIEN,REMNM,IEN)=RMIEN
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. GETDATA(RGIEN,RMIEN,RIEN) ;EP - Get the reminder help text
  1.  NEW NAME,CODE,HIEN,IEN,CAT,CLIN,STATUS
  1.  S NAME=$P(^BQI(90506.1,RIEN,0),U,3),CODE=$P(^(0),U,1)
  1.  ;S CAT=$$GET1^DIQ(90506.1,RIEN_",",2.03,"E")
  1.  ;S CLIN=$$GET1^DIQ(90506.1,RIEN_",",2.05,"E")
  1.  S CAT=$$GET1^DIQ(90506.1,RIEN_",",3.03,"E")
  1.  S CLIN=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
  1.  S TXIEN=0,TEXT=""
  1.  F  S TXIEN=$O(^BQI(90507,RGIEN,15,RMIEN,13,TXIEN)) Q:'TXIEN  D
  1.  . S TEXT=TEXT_^BQI(90507,RGIEN,15,RMIEN,13,TXIEN,0)_$C(10)
  1.  S TEXT=$$TKO^BQIUL1(TEXT,$C(10))
  1.  S II=II+1,@DATA@(II)=RIEN_"^"_$P(^BQI(90506.1,RIEN,0),U,3)_"^"_CODE_"^"_CAT_"^"_CLIN_"^"_TEXT_$C(30)
  1.  Q