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

BQIRMPL.m

Go to the documentation of this file. 
  1. BQIRMPL ;PRXM/HC/ALA-Reminders By Panel ; 20 Feb 2007  4:04 PM
  1.  ;;2.5;ICARE MANAGEMENT SYSTEM;**2**;May 24, 2016;Build 14
  1.  ;
  1.  Q
  1.  ;
  1. EN(DATA,OWNR,PLIEN,PLIST) ;EP -- BQI GET REMINDERS BY PANEL
  1.  ;Description - Entry point for the panel
  1.  ;Input Parameters
  1.  ;  OWNR  - Owner of panel
  1.  ;  PLIEN - Panel IEN
  1.  ;  PLIST - List of DFNs (optional)
  1.  NEW UID,II,X,BQIRM,VAL,DFN,HIEN,E,J,K,L,MAX,MIN,NAFLG,STVWCD
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIRMPL",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRMPL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  ; If a list of DFNs, process them instead of entire panel
  1.  I $D(PLIST)>0 D  G DONE
  1.  . I $D(PLIST)>1 D
  1.  .. S LIST="",BN=""
  1.  .. F  S BN=$O(PLIST(BN)) Q:BN=""  S LIST=LIST_PLIST(BN)
  1.  .. K PLIST S PLIST=LIST
  1.  . F BQI=1:1 S DFN=$P(PLIST,$C(28),BQI) Q:DFN=""  D
  1.  .. I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q
  1.  .. D PAT(.DATA,OWNR,PLIEN,DFN)
  1.  ;
  1.  S DFN=0
  1.  I $O(^BQICARE(OWNR,1,PLIEN,40,DFN))="" D PAT(.DATA,OWNR,PLIEN,"") G DONE
  1.  ;
  1.  F  S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN  D
  1.  . I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q
  1.  . D PAT(.DATA,OWNR,PLIEN,DFN)
  1.  ;
  1. DONE ;
  1.  I II=0,$G(@DATA@(II))="" D PAT(.DATA,OWNR,PLIEN,"")
  1.  S II=II+1,@DATA@(II)=$C(31)
  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. PAT(DATA,OWNR,PLIEN,DFN) ;EP - Build record by patient
  1.  NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,ORD
  1.  S VALUE="",CTYP="R"
  1.  I DFN'="" S Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I"),HDOB=$$FMTE^BQIUL1(Y)
  1.  I DFN'="" S VALUE=DFN_U_$$FLG^BTPWPPAT(DFN)_U_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_U_$$SENS^BQIULPT(DFN)_U_$$CALR^BQIULPT(DFN)_U_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_U_HDOB_U
  1.  S HEADR="I00010DFN^T00001TICKLER_INDICATOR^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030HIDE_DOB^"
  1.  ; Check for template
  1.  NEW DA,IENS,TEMPL,LYIEN,QFL
  1.  S TEMPL=""
  1.  I OWNR'=DUZ D
  1.  . S DA=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,4,"C",CTYP,""))
  1.  . I DA="" Q
  1.  . S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,IENS=$$IENS^DILF(.DA)
  1.  . S TEMPL=$$GET1^DIQ(90505.34,IENS,.01,"E")
  1.  I OWNR=DUZ D
  1.  . S DA=$O(^BQICARE(OWNR,1,PLIEN,4,"C",CTYP,""))
  1.  . I DA="" Q
  1.  . S DA(2)=OWNR,DA(1)=PLIEN,IENS=$$IENS^DILF(.DA)
  1.  . S TEMPL=$$GET1^DIQ(90505.14,IENS,.01,"E")
  1.  ;
  1.  ; If template, use it
  1.  I TEMPL'="" S QFL=0 D  G FIN:'QFL
  1.  . ;S LYIEN=$$DEF^BQILYUTL(OWNR,"M")
  1.  . S LYIEN=$$TPN^BQILYUTL(DUZ,TEMPL)
  1.  . I LYIEN="" S QFL=1 Q
  1.  . S DOR=""
  1.  . F  S DOR=$O(^BQICARE(DUZ,15,LYIEN,1,"C",DOR)) Q:DOR=""  D
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^BQICARE(DUZ,15,LYIEN,1,"C",DOR,IEN)) Q:IEN=""  D
  1.  ... S CODE=$P(^BQICARE(DUZ,15,LYIEN,1,IEN,0),U,1)
  1.  ... S GIEN=$O(^BQI(90506.1,"B",CODE,"")) I GIEN="" Q
  1.  ... S STVW=GIEN
  1.  ... I $P(^BQI(90506.1,GIEN,0),U,10)=1 Q
  1.  ... S HDR=$$GET1^DIQ(90506.1,GIEN_",",.08,"E")
  1.  ... I $$GET1^DIQ(90506.1,GIEN_",",3.01,"E")="Patient" S STVW=GIEN D CVAL
  1.  ... I $$GET1^DIQ(90506.1,GIEN_",",3.01,"E")="Reminders" S STVW=CODE D RMVL
  1.  ... S VALUE=VALUE_VAL_"^"
  1.  ... S HEADR=HEADR_HDR_"^"
  1.  ;
  1.  ; If no template, check for customized
  1.  I OWNR=DUZ D
  1.  . S IEN=0,CIEN=$O(^BQICARE(OWNR,1,PLIEN,22,IEN))
  1.  . I CIEN'="" D  Q
  1.  .. F  S IEN=$O(^BQICARE(OWNR,1,PLIEN,22,IEN)) Q:'IEN  D
  1.  ... S CODE=$P(^BQICARE(OWNR,1,PLIEN,22,IEN,0),"^",1)
  1.  ... S SIEN=$O(^BQI(90506.1,"B",CODE,"")) I SIEN="" Q
  1.  ... I $P(^BQI(90506.1,SIEN,0),U,10)=1 Q
  1.  ... S HDR=$$GET1^DIQ(90506.1,SIEN_",",.08,"E")
  1.  ... I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient" S STVW=SIEN D CVAL
  1.  ... I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Reminders" S STVW=CODE D RMVL
  1.  ... S VALUE=VALUE_VAL_"^"
  1.  ... S HEADR=HEADR_HDR_"^"
  1.  . ;
  1.  . ; If no customized found, use default
  1.  . I CIEN="" D STAND()
  1.  ;
  1.  I OWNR'=DUZ D
  1.  . S IEN=0,CIEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN))
  1.  . I CIEN'="" D  Q
  1.  .. F  S IEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN)) Q:'IEN  D
  1.  ... S CODE=$P(^BQICARE(OWNR,1,PLIEN,30,DUZ,22,IEN,0),"^",1)
  1.  ... S SIEN=$O(^BQI(90506.1,"B",CODE,"")) I SIEN="" Q
  1.  ... I $P(^BQI(90506.1,SIEN,0),U,10)=1 Q
  1.  ... S HDR=$$GET1^DIQ(90506.1,SIEN_",",.08,"E")
  1.  ... I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient" S STVW=SIEN D CVAL
  1.  ... I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Reminders" S STVW=CODE D RMVL
  1.  ... S VALUE=VALUE_VAL_"^"
  1.  ... S HEADR=HEADR_HDR_"^"
  1.  . ;
  1.  . ; If no customized found, use default
  1.  . I CIEN="" D STAND()
  1.  ;
  1. FIN ; Finish
  1.  ; remove trailing up-arrows
  1.  S HEADR=$$TKO^BQIUL1(HEADR,"^")
  1.  S VALUE=$$TKO^BQIUL1(VALUE,"^")
  1.  I DFN="" S VALUE=""
  1.  ;
  1.  I II=0 S @DATA@(II)=HEADR_$C(30)
  1.  I VALUE'="",$P($G(@DATA@(II)),$C(30),1)'=VALUE S II=II+1,@DATA@(II)=VALUE_$C(30)
  1.  Q
  1.  ;
  1. STAND() ;EP - Get standard display
  1.  NEW IEN,HDR,SENS,HDOB,Y,STVW,TEXT,ORD,KEY
  1.  S VALUE=""
  1.  I DFN'="" S Y=$$GET1^DIQ(9000001,DFN_",",1102.2,"I"),HDOB=$$FMTE^BQIUL1(Y)
  1.  I DFN'="" S VALUE=DFN_U_$$FLG^BTPWPPAT(DFN)_U_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_U_$$SENS^BQIULPT(DFN)_U_$$CALR^BQIULPT(DFN)_U_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_U_HDOB_U
  1.  S HEADR="I00010DFN^T00001TICKLER_INDICATOR^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030HIDE_DOB^"
  1.  S IEN=""
  1.  F  S IEN=$O(^BQI(90506.1,"AC","D",IEN)) Q:IEN=""  D
  1.  . I $P(^BQI(90506.1,IEN,0),U,10)=1 Q
  1.  . S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
  1.  . I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
  1.  . I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
  1.  .. S STVW=IEN
  1.  .. D CVAL
  1.  .. S VALUE=VALUE_VAL_"^"
  1.  .. S HEADR=HEADR_HDR_"^"
  1.  ;
  1.  S IEN=""
  1.  F  S IEN=$O(^BQI(90506.1,"AC","R",IEN)) Q:IEN=""  D
  1.  . I $P(^BQI(90506.1,IEN,0),U,10)=1 Q
  1.  . S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
  1.  . I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
  1.  . I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
  1.  .. S STVW=$P(^BQI(90506.1,IEN,0),U,1)
  1.  .. S HDR=$P(^BQI(90506.1,IEN,0),U,8)
  1.  .. D RMVL
  1.  .. S VALUE=VALUE_VAL_"^"
  1.  .. S HEADR=HEADR_HDR_"^"
  1.  S HEADR=$$TKO^BQIUL1(HEADR,"^")
  1.  S VALUE=$$TKO^BQIUL1(VALUE,"^")
  1.  ;
  1.  I DFN="" S VALUE=""
  1.  ;
  1.  I II=0 S @DATA@(II)=HEADR_$C(30)
  1.  I VALUE'="" S II=II+1,@DATA@(II)=VALUE_$C(30)
  1.  Q
  1.  ;
  1. CVAL ; Get demographic values
  1.  ;Parameters
  1.  ;  FIL  = FileMan file number
  1.  ;  FLD  = FileMan field number
  1.  ;  EXEC = If an executable is needed to determine value
  1.  ;  HDR  = Header value
  1.  ;the executable expects the value to be returned in variable VAL
  1.  NEW FIL,FLD,EXEC
  1.  S FIL=$$GET1^DIQ(90506.1,STVW_",",.05,"E")
  1.  S FLD=$$GET1^DIQ(90506.1,STVW_",",.06,"E")
  1.  S EXEC=$$GET1^DIQ(90506.1,STVW_",",1,"E")
  1.  S HDR=$$GET1^DIQ(90506.1,STVW_",",.08,"E")
  1.  I $G(DFN)="" S VAL="" Q
  1.  ;
  1.  I $G(EXEC)'="" X EXEC Q
  1.  ;
  1.  I FIL'="",FLD'="" S VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
  1.  Q
  1.  ;
  1. RMVL ;  Reminder value
  1.  NEW RDATA,CT,I,RIEN,BQIDOD,CMIEN,REG,DUE
  1.  S CMIEN=""
  1.  I DFN="" S VAL="",HDR="T00025"_STVW Q
  1.  ; If patient is deceased
  1.  S BQIDOD=$$GET1^DIQ(2,DFN_",",.351,"I") I BQIDOD'="" S VAL="1/1/0001 12:00:00 AM" Q
  1.  ; if patient has no reminders, then No Data Available (NDA)
  1.  I $O(^BQIPAT(DFN,40,0))="" S VAL="1/1/0001 12:00:00 AM" Q
  1.  I $L(STVW,"_")>2 D
  1.  . S REG=$P(STVW,"_",2) I REG'="" D
  1.  .. S CMIEN=$O(^BQI(90506.5,"D",REG,""))
  1.  ; if patient does not meet denominator, then Not Applicable (N/A)
  1.  I CMIEN'="",'$$NRPC^BQICMDNM(DFN,CMIEN) S VAL="1/1/0001 12:01:00 AM" Q
  1.  ; if patient has no data for this particular reminder, then Not Applicable (N/A)
  1.  S RIEN=$O(^BQIPAT(DFN,40,"B",STVW,"")) I RIEN="" S VAL="1/1/0001 12:01:00 AM" Q
  1.  S RDATA=$G(^BQIPAT(DFN,40,RIEN,0))
  1.  S CT=0
  1.  ; if a particular reminder is completed with DONE or RESOLVED, then Not Applicable (N/A)
  1.  I $P(STVW,"_",1)="EHR" S EQFL=0 D  Q:EQFL
  1.  . I $P(RDATA,U,3)="N/A" S VAL="1/1/0001 12:01:00 AM",EQFL=1 Q
  1.  . I $P(RDATA,U,3)="DONE" S VAL="1/1/0001 12:01:00 AM",EQFL=1 Q
  1.  . I $P(RDATA,U,3)="RESOLVED" S VAL="1/1/0001 12:01:00 AM",EQFL=1 Q
  1.  F I=2:1:4 S:$P(RDATA,U,I)'=""&($P(RDATA,U,I)'="N/A") CT=CT+1
  1.  S HDR="T00030"_STVW
  1.  I CT=0 S VAL="1/1/0001 12:01:00 AM" Q
  1.  S DUE=$P(RDATA,U,4)
  1.  I $P(RDATA,U,3)'="",DUE="" S DUE=DT
  1.  S VAL=$$FMTMDY^BQIUL1(DUE)
  1.  Q
  1.  ;
  1. RDEF() ;EP - Reminders default
  1.  NEW RVALUE,IEN,STVCD,REMNM,BQIARRAY,KEY
  1.  S RVALUE=""
  1.  ;
  1.  ; Check for normal display order
  1.  S DOR="" F  S DOR=$O(^BQI(90506.1,"AD","D",DOR)) Q:DOR=""  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^BQI(90506.1,"AD","D",DOR,IEN)) Q:IEN=""  D
  1.  .. I $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1 Q
  1.  .. S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
  1.  .. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
  1.  .. I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
  1.  ... S STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
  1.  ... S RVALUE=RVALUE_STVCD_$C(29)
  1.  S IEN=""
  1.  F  S IEN=$O(^BQI(90506.1,"AC","R",IEN)) Q:IEN=""  D
  1.  . S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
  1.  . I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
  1.  . I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
  1.  .. I $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1 Q
  1.  .. S STVCD=$$GET1^DIQ(90506.1,IEN_",",.01,"E")
  1.  .. S REMNM=$$GET1^DIQ(90506.1,IEN_",",.03,"E")
  1.  .. S BQIARRAY(REMNM,IEN)=STVCD
  1.  S REMNM=""
  1.  F  S REMNM=$O(BQIARRAY(REMNM)) Q:REMNM=""  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(BQIARRAY(REMNM,IEN)) Q:IEN=""  D
  1.  .. S STVCD=BQIARRAY(REMNM,IEN)
  1.  .. S RVALUE=RVALUE_STVCD_$C(29)
  1.  S RVALUE=$$TKO^BQIUL1(RVALUE,$C(29))
  1.  Q RVALUE