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

BQINOTR.m

Go to the documentation of this file. 
  1. BQINOTR ;GDIT/HS/ALA-Reminder Notification Log ; 03 Jan 2013  12:21 PM
  1.  ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
  1.  ;
  1. LOG(DFN,NTYP,TIUP,IMML,PWHN,REM,PROV) ;PEP - Log a notification entry
  1.  ; Input
  1.  ;   DFN  - Patient IEN
  1.  ;   NTYP - Notification Type LETTER, EMAIL, PHONE
  1.  ;   TIUP - TIU note pointer
  1.  ;   IMML - Immunization letter pointer
  1.  ;   PWHN - Patient Wellness Handout pointer (no longer needed)
  1.  ;   REM  - Reminder (IMMUNIZATIONS if from immunization package)
  1.  ;   PROV - Provider
  1.  ;
  1.  NEW DDATA
  1.  S DDATA=$P($G(^DD(90509.4,.02,0)),U,3)
  1.  I DDATA[":MAIL" D
  1.  . I NTYP="LETTER" S NTYP="MAIL"
  1.  NEW DIC,DIE,X,DLAYGO,IEN,Y,PTPF,BQIUPD,BQIEXT,RMM,D
  1.  S DIC="^BQI(90509.4,",DIE=DIC,X=DFN
  1.  S DLAYGO=90509.4,DIC(0)="L",DIC("P")=DLAYGO
  1.  K DO,DD D FILE^DICN
  1.  S IEN=+Y I Y=-1 Q
  1.  S PTPF=$$GET1^DIQ(9000001,DFN_",",4002,"E")
  1.  S BQIUPD(90509.4,IEN_",",.05)=DUZ,BQIUPD(90509.4,IEN_",",.04)=$$NOW^XLFDT()
  1.  S BQIEXT(90509.4,IEN_",",.02)=PTPF,BQIEXT(90509.4,IEN_",",.03)=NTYP
  1.  S BQIUPD(90509.4,IEN_",",.06)=$G(TIUP),BQIUPD(90509.4,IEN_",",.07)=$G(PWHN)
  1.  S BQIUPD(90509.4,IEN_",",.09)=$G(REM),BQIUPD(90509.4,IEN_",",.08)=$G(PROV)
  1.  I REM="IMMUNIZATIONS" D IMM(DFN)
  1.  I REM'="",REM'="IMMUNIZATIONS" D DUE(DFN,REM)
  1.  I $D(BQIEXT) D FILE^DIE("E","BQIEXT","ERROR")
  1.  I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  Q
  1.  ;
  1. IMM(BIDFN) ;EP - Expand immunization reminders
  1.  NEW FRN,IT,RCDUE,OVDUE,REMDUE
  1.  D IMM^BQIRMIZ(BIDFN)
  1.  I '$D(^BQI(90509.4,IEN,1,0)) S ^BQI(90509.4,IEN,1,0)="^90509.41^^"
  1.  S FRN=""
  1.  F  S FRN=$O(^BIPDUE("B",BIDFN,FRN)) Q:FRN=""  D
  1.  . S IT=$P(^BIPDUE(FRN,0),"^",2)
  1.  . S RCDUE=$P(^BIPDUE(FRN,0),"^",4),OVDUE=$P(^(0),"^",5)
  1.  . S REMDUE=$S(RCDUE'="":RCDUE,1:OVDUE)
  1.  . S BTYP=$P(^AUTTIMM(IT,0),"^",2)
  1.  . NEW DA,IENS
  1.  . S DA(1)=IEN,X=BTYP,DIC="^BQI(90509.4,"_DA(1)_",1,",DIC(0)="L",DLAYGO=90509.41
  1.  . D ^DIC S DA=+Y
  1.  . S IENS=$$IENS^DILF(.DA),BQIUPD(90509.41,IENS,.02)=REMDUE
  1.  I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  Q
  1.  ;
  1. DUE(BQDFN,REM) ;EP - Reminders from ICARE PATIENT file
  1.  NEW RN,DUE
  1.  S RN=$O(^BQIPAT(BQDFN,40,"B",REM,"")) I RN="" Q
  1.  S DUE=$P(^BQIPAT(BQDFN,40,RN,0),U,4)
  1.  S BQIUPD(90509.4,IEN_",",.1)=DUE
  1.  Q
  1.  ;
  1. COMP(BQDFN,REM) ;EP - Set completion
  1.  NEW RN,DUE,RMN,BQIUPD,NNIEN,IMN,LIMM,IMIEN,NDUE
  1.  S RN=$O(^BQIPAT(BQDFN,40,"B",REM,"")) I RN'="" D
  1.  . S DUE=$P(^BQIPAT(BQDFN,40,RN,0),U,4),LIMM=$P(^(0),U,2)
  1.  . ;
  1.  . S RMN=$O(^BQI(90509.4,"C",BQDFN,REM,""),-1) I RMN="" Q
  1.  . S NDUE=$$GET1^DIQ(90509.4,RMN_",",.1,"I")
  1.  . I DUE'="",NDUE'=DUE D
  1.  .. I LIMM'="",LIMM>NDUE S BQIUPD(90509.4,RMN_",",.11)=LIMM
  1.  ;
  1.  I $D(BQIUPD) D FILE^DIE("I","BQIUPD","ERROR")
  1.  I '$D(^BQI(90509.4,"C",BQDFN,"IMMUNIZATIONS")) Q
  1.  ;
  1.  S NNIEN=""
  1.  F  S NNIEN=$O(^BQI(90509.4,"C",BQDFN,"IMMUNIZATIONS",NNIEN)) Q:NNIEN=""  D
  1.  . S RMM=""
  1.  . F  S RMM=$O(^BQI(90509.4,NNIEN,1,"B",RMM)) Q:RMM=""  D
  1.  .. S RMN=$O(^BQI(90509.4,NNIEN,1,"B",RMM,""))
  1.  .. S IMNM=$P(^BQI(90509.4,NNIEN,1,RMN,0),"^",1),DUE=$P(^(0),"^",2)
  1.  .. S IMIEN=$O(^AUTTIMM("AC",IMNM,"")) I IMIEN="" Q
  1.  .. S LIMM=$$LIMM^BQIREM(BQDFN,IMIEN),LIMM=$P(LIMM,"^",1)
  1.  .. NEW DA,IENS
  1.  .. S DA(1)=NNIEN,DA=RMN,IENS=$$IENS^DILF(.DA)
  1.  .. I LIMM>DUE S BQIUPD(90509.41,IENS,.03)=LIMM
  1.  I $D(BQIUPD) D FILE^DIE("I","BQIUPD","ERROR")
  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(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1.  Q
  1.  ;
  1. UPD(DATA,OWNR,PLIEN,BQINOTT,TIUDA,REMCODE,DFN) ; EP - BQI UPDATE REMINDER NOTIFY
  1.  NEW UID
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQINOTUP",UID))
  1.  K @DATA
  1.  ;
  1.  S BQII=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQINOTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(BQII)="I00010RESULT^T01024MSG"_$C(30)
  1.  S BQINOTT=$G(BQINOTT,""),TIUDA=$G(TIUDA,""),REMCODE=$G(REMCODE,"")
  1.  I $G(OWNR),$G(PLIEN) D
  1.  . S PRN=$O(^BQICARE(OWNR,1,PLIEN,10,"B","PROV","")) I PRN="" S PROV="" Q
  1.  . S PROV=$P(^BQICARE(OWNR,1,PLIEN,10,PRN,0),U,3)
  1.  K ERROR
  1.  D LOG(DFN,BQINOTT,TIUDA,$G(IMML),$G(PWHN),REMCODE,PROV)
  1.  S RESULT=1_U
  1.  I $D(ERROR)>0 S RESULT=-1_U_$G(ERROR("DIERR","1","TEXT","1"))
  1.  S BQII=BQII+1,@DATA@(BQII)=RESULT_$C(30)
  1.  S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1.  Q
  1.  ;
  1. REF(DATA,OWNR,PLIEN,REMCODE,DFN) ;EP - BQI REFRESH REMINDER NOTIFY
  1.  NEW UID
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQINOTRF",UID))
  1.  K @DATA
  1.  S HEADR="I00010DFN^",VALUE=DFN_U
  1.  ;
  1.  S BQII=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQINOTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S GIEN=0,CRN=$O(^BQI(90506.5,"C","RE","")),RIEN=REMCODE
  1.  F  S GIEN=$O(^BQI(90506.5,CRN,10,GIEN)) Q:'GIEN  D
  1.  . S DIS=$P(^BQI(90506.5,CRN,10,GIEN,0),U,5),STVCD=$P(^(0),U,1)
  1.  . I $P(^BQI(90506.5,CRN,10,GIEN,0),U,9)=1 S IFL=1 Q
  1.  . S BQDTFRM=$P(^BQI(90506.5,CRN,10,GIEN,0),U,8) S:BQDTFRM="" BQDTFRM="S"
  1.  . S RES=$$FND^BQICMUTL(CRN,GIEN,DFN)
  1.  . I 'RES S HDR="T00025"_STVCD,VAL="" Q
  1.  . I DIS="" S HDR="T00025"_STVCD,VAL=RES
  1.  . I DIS="D" D
  1.  .. S HDR="T00025"_STVCD
  1.  .. S VAL=$S(BQDTFRM="S":$$FMTE^BQIUL1($P(RES,U,2)),1:$$FMTMDY^BQIUL1($P(RES,U,2)))
  1.  . I DIS="R" S HDR="T00025"_STVCD,VAL=$P(RES,U,2)
  1.  . I DIS="B" D
  1.  .. S HDR="T00025"_STVCD
  1.  .. S VAL=$S(BQDTFRM="S":$$FMTE^BQIUL1($P(RES,U,2)),1:$$FMTMDY^BQIUL1($P(RES,U,2)))_" "_$P(RES,U,3)
  1.  . S HEADR=HEADR_HDR_U
  1.  . S VALUE=VALUE_VAL_U
  1.  S HEADR=$$TKO^BQIUL1(HEADR,"^")
  1.  S VALUE=$$TKO^BQIUL1(VALUE,"^")
  1.  ;
  1.  S @DATA@(BQII)=HEADR_$C(30)
  1.  S BQII=BQII+1,@DATA@(BQII)=VALUE_$C(30)
  1.  S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1.  Q
  1.  ;
  1. LNOT(BQIDFN) ;EP - Get the last patient's notification information
  1.  NEW DATE,NIEN,TYPE,IEN
  1.  I $O(^BQI(90509.4,"D",BQIDFN,""))="" Q ""
  1.  S DATE=$O(^BQI(90509.4,"D",BQIDFN,""),-1) I DATE="" Q ""
  1.  S NIEN=$O(^BQI(90509.4,"D",BQIDFN,DATE,""),-1) I NIEN="" Q ""
  1.  S TYPE=$P($G(^BQI(90509.4,NIEN,0)),"^",9) I TYPE="" Q ""
  1.  I TYPE["IMMUNIZATION" Q $$FMTE^XLFDT(DATE,"5Z")_" ("_TYPE_")"
  1.  I TYPE="PWH" Q $$FMTE^XLFDT(DATE,"5Z")_" (Patient Wellness)"
  1.  S IEN=""
  1.  I TYPE["_" S IEN=$O(^BQI(90506.1,"B",TYPE,IEN))
  1.  I IEN'="" S TYPE=$P(^BQI(90506.1,IEN,0),"^",3)
  1.  Q $$FMTE^XLFDT(DATE,"5Z")_$S(TYPE'="":" ("_TYPE_")",1:"")
  1.  ;
  1. LIMM(BQIDFN) ;EP - Get the last immunization notification for a patient
  1.  NEW TYPE,NIEN,DATE
  1.  S TYPE="IMMUNIZATIONS"
  1.  I $O(^BQI(90509.4,"C",BQIDFN,"IMMUNIZATIONS",""))="" Q ""
  1.  S NIEN=$O(^BQI(90509.4,"C",BQIDFN,"IMMUNIZATIONS",""),-1) I NIEN="" Q ""
  1.  S DATE=$P(^BQI(90509.4,NIEN,0),"^",4)\1
  1.  Q $$FMTE^XLFDT(DATE,"5Z")