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

BQIFLGET.m

Go to the documentation of this file. 
  1. BQIFLGET ;GDIT/HS/ALA-Get flags ; 14 Dec 2005  11:22 AM
  1.  ;;2.3;ICARE MANAGEMENT SYSTEM;**1**;Apr 18, 2012;Build 43
  1.  ;
  1.  Q
  1.  ;
  1. RET(DATA,DTYP,OWNR,PLIEN,DFN) ; EP -- BQI GET FLAGS
  1.  ;
  1.  ;Description
  1.  ;
  1.  ;Input
  1.  ;  DTYP  = Display Type; 'A'=All flags, 'S'=Shown flags,
  1.  ;                       'H'=Hidden flags
  1.  ;  OWNR  = User identifier if DUZ is a shared person
  1.  ;  PLIEN = Panel IEN
  1.  ;  DFN   = Patient identifier
  1.  ;
  1.  NEW UID,II,DOB,SENS,PTSEX,PTAGE,HRN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIFLGET",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIFLGET D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="I00010FLAG_DEF_IEN^I00010FLAG_IEN^I00010DFN^T00030PATIENT_NAME^T00030HRN^T00050DPCP^T00030FLAG_TYPE^D00015FLAG_DATE^T00010FLAG_ACTION^T00001FLAG_STATUS^T00250FLAG_DESC^D00030DOB^T00001SENS_FLAG^T00001SEX^T00007AGE"_$C(30)
  1.  S DFN=$G(DFN,"")
  1.  S OWNR=$G(OWNR,"")
  1.  ;
  1.  I $G(DFN)'="" D PAT G DONE
  1.  I $G(OWNR)'="" D PNL G DONE
  1.  D ALL
  1.  ;
  1. DONE ; Finish the RPC call
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  K PARMS,MPARMS,ADTM,ADATM,ADESC,ADIEN,ALIEN,X,Y,TMFRAME,NM,REFLOW
  1.  K STAT,DA,IENS,AACT,FDT,TDT,SOURCE,VALUE,NAME,PIEN,PMIEN,PTYP,SPNLNM
  1.  K HRN,AIEN,FSTAT,FDTM,RIEN,%DT,PNAME,VIEN,PARMS,MPARMS,ORPHY,TST,UNIT
  1.  K RANGE,RSLT,TEST,AFLG,BQIPREF,PLIEN,NRMABN,PAR,PNL,PNLNM,REFHIGH,VISIT
  1.  Q
  1.  ;
  1. ALL ;  For all patients defined in the patient lists for the user.
  1.  ;
  1.  ;Parameters
  1.  ;  DFN   = Patient internal entry number
  1.  ;  ADIEN = Flag definition internal entry number
  1.  ;  ADESC = Flag definition description
  1.  ;  TMFRAME = Relative date defined by user
  1.  ;  ALIEN   = Flag record internal entry number
  1.  ;  ADTM,FDT  = Time Frame starting date
  1.  ;  ADATM   = Flag date
  1.  ;  STAT  = Status of the flag for this user
  1.  ;  AACT  = Flag Action (S=Show, H=Hide)
  1.  ;  DOB   = Patient's Date of Birth
  1.  ;  SENS  = Sensitive Patient Flag
  1.  ;  PTSEX = Patient's gender
  1.  ;  PTAGE = Patient's current age
  1.  ;
  1.  D RET^BQIFLAG(DUZ,.BQIPREF)
  1.  S ADIEN=0
  1.  F  S ADIEN=$O(BQIPREF(ADIEN)) Q:'ADIEN  D
  1.  . ; If the flag entry is inactive, quit
  1.  . I $P(^BQI(90506,ADIEN,0),U,2)=1 Q
  1.  . S ADESC=$P(^BQI(90506,ADIEN,0),U,1)
  1.  . S FDT=$P(BQIPREF(ADIEN),U,1),TDT=$P(BQIPREF(ADIEN),U,2)
  1.  . S FDTM=FDT
  1.  . F  S FDTM=$O(^BQIPAT("AE",ADIEN,FDTM)) Q:FDTM=""!(FDTM\1>TDT)  D
  1.  .. S DFN=""
  1.  .. F  S DFN=$O(^BQIPAT("AE",ADIEN,FDTM,DFN)) Q:DFN=""  D
  1.  ... I $D(^BQICARE(DUZ,1,"AB",DFN)) D  Q:'AFLG
  1.  .... ;
  1.  .... ; Check if patient is active on any panel (AFLG=1)
  1.  .... ;
  1.  .... S PLIEN="",AFLG=0
  1.  .... F  S PLIEN=$O(^BQICARE(DUZ,1,"AB",DFN,PLIEN)) Q:PLIEN=""  D  Q:AFLG
  1.  ..... I $G(^BQICARE(DUZ,1,PLIEN,40,DFN,0))="" K ^BQICARE(DUZ,1,"AB",DFN,PLIEN) Q
  1.  ..... I $P(^BQICARE(DUZ,1,PLIEN,40,DFN,0),U,2)'="R" S AFLG=1
  1.  ... ;
  1.  ... ;  If patient isn't on one of user's panels but is on a shared panel
  1.  ... I '$D(^BQICARE(DUZ,1,"AB",DFN)),'$$SHR(DUZ,DFN) Q
  1.  ... S ALIEN=0
  1.  ... F  S ALIEN=$O(^BQIPAT("AE",ADIEN,FDTM,DFN,ALIEN)) Q:ALIEN=""  D
  1.  .... S PNAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
  1.  .... NEW FDESC
  1.  .... Q:'$D(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ))
  1.  .... S STAT=+$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ,0),U,2)
  1.  .... ;  if the status is '1' Don't Show and the display type is 'S' don't select
  1.  .... I STAT=1,DTYP="S" Q
  1.  .... I 'STAT,DTYP="H" Q
  1.  .... ;  If the status is 1, set action to "reactivate" and flag status to "hide"
  1.  .... ;  If the status is not 1, set action to "deactivate" and flag status to "show"
  1.  .... S AACT=$S(STAT=1:"S",1:"H"),FSTAT=$S(STAT=1:"H",1:"S")
  1.  .... ;  Get the record ien associated with the flag
  1.  .... S RIEN=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,1)
  1.  .... S ADATM=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,2)
  1.  .... S VIEN=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,4)
  1.  .... S ADATM=$$FMTE^BQIUL1(ADATM\1)
  1.  .... I ADESC["LAB" D
  1.  ..... D LAB^BQIRLB(RIEN)
  1.  ..... S FDESC=TEST_" "_RSLT_" "_RANGE_" "_NRMABN_" "_ORPHY
  1.  .... I ADESC'["LAB" D
  1.  ..... I VIEN="" Q
  1.  ..... NEW NARR
  1.  ..... S FDESC="Provider: "_$$PRV^BQIUL1(VIEN)
  1.  ..... S NARR=$$VVNAR^BQIUL1(VIEN)
  1.  ..... I NARR="" S NARR=$$VPNAR^BQIUL1(VIEN)
  1.  ..... S FDESC=FDESC_$C(13)_$C(10)_"POVs: "_NARR
  1.  .... S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
  1.  .... S PTSEX=$$GET1^DIQ(2,DFN_",",.02,"I")
  1.  .... S PTAGE=$$AGE^BQIAGE(DFN,,1)
  1.  .... S SENS=$$SENS^BQIULPT(DFN)
  1.  .... S HRN=$$HRNL^BQIULPT(DFN),HRN=$TR(HRN,";",$C(10))
  1.  .... S II=II+1
  1.  .... S @DATA@(II)=ADIEN_"^"_ALIEN_"^"_DFN_"^"_PNAME_"^"_HRN_"^"_$P($$DPCP^BQIULPT(DFN),"^",2)_"^"_ADESC_"^"_ADATM_"^"_AACT_"^"_FSTAT_"^"_$G(FDESC)_"^"_DOB_"^"_SENS_"^"_PTSEX_"^"_PTAGE_$C(30)
  1.  Q
  1.  ;
  1. PAT ;  Get flags for one patient
  1.  ;
  1.  ;Parameters
  1.  ;  PNAME = Patient's name
  1.  ;
  1.  S PNAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
  1.  D RET^BQIFLAG(DUZ,.BQIPREF)
  1.  I '$$FPAT^BQIFLAG(DFN,DUZ,.BQIPREF,DTYP) Q
  1.  S ADIEN=0
  1.  F  S ADIEN=$O(BQIPREF(ADIEN)) Q:'ADIEN  D
  1.  . ; If the flag entry is inactive, quit
  1.  . I $P(^BQI(90506,ADIEN,0),"^",2)=1 Q
  1.  . S ADESC=$P(^BQI(90506,ADIEN,0),U,1)
  1.  . S FDT=$P(BQIPREF(ADIEN),U,1),TDT=$P(BQIPREF(ADIEN),U,2)
  1.  . S FDTM=FDT
  1.  . F  S FDTM=$O(^BQIPAT("AF",DFN,ADIEN,FDTM)) Q:FDTM=""!(FDTM\1>TDT)  D
  1.  .. S ALIEN=0
  1.  .. F  S ALIEN=$O(^BQIPAT("AF",DFN,ADIEN,FDTM,ALIEN)) Q:'ALIEN  D
  1.  ... NEW FDESC
  1.  ... Q:'$D(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ))
  1.  ... S STAT=+$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ,0),U,2)
  1.  ... ;  if the status is '1' Don't Show and the display type is 'S' don't select
  1.  ... I STAT=1,DTYP="S" Q
  1.  ... I 'STAT,DTYP="H" Q
  1.  ... ;  If the status is 1, set action to "reactivate" and flag status to "hide"
  1.  ... ;  If the status is not 1, set action to "deactivate" and flag status to "show"
  1.  ... S AACT=$S(STAT=1:"S",1:"H"),FSTAT=$S(STAT=1:"H",1:"S")
  1.  ... ;  Get the record ien associated with the flag
  1.  ... S RIEN=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,1)
  1.  ... S ADATM=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,2)
  1.  ... S VIEN=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,4)
  1.  ... S ADATM=$$FMTE^BQIUL1(ADATM\1)
  1.  ... I ADESC["LAB" D
  1.  .... D LAB^BQIRLB(RIEN)
  1.  .... S FDESC=TEST_" "_RSLT_" "_RANGE_" "_NRMABN_" "_ORPHY
  1.  ... I ADESC'["LAB" D
  1.  .... I VIEN="" Q
  1.  .... NEW NARR
  1.  .... S FDESC="Provider: "_$$PRV^BQIUL1(VIEN)
  1.  .... S NARR=$$VVNAR^BQIUL1(VIEN)
  1.  .... I NARR="" S NARR=$$VPNAR^BQIUL1(VIEN)
  1.  .... S FDESC=FDESC_$C(13)_$C(10)_"POVs: "_NARR
  1.  ... S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
  1.  ... S PTSEX=$$GET1^DIQ(2,DFN_",",.02,"I")
  1.  ... S PTAGE=$$AGE^BQIAGE(DFN,,1)
  1.  ... S SENS=$$SENS^BQIULPT(DFN)
  1.  ... S HRN=$$HRNL^BQIULPT(DFN),HRN=$TR(HRN,";",$C(10))
  1.  ... S II=II+1
  1.  ... S @DATA@(II)=ADIEN_"^"_ALIEN_"^"_DFN_"^"_PNAME_"^"_HRN_"^"_$P($$DPCP^BQIULPT(DFN),"^",2)_"^"_ADESC_"^"_ADATM_"^"_AACT_"^"_FSTAT_"^"_$G(FDESC)_"^"_DOB_"^"_SENS_"^"_PTSEX_"^"_PTAGE_$C(30)
  1.  Q
  1.  ;
  1. PNL ;  Get all flags for patients in a panel
  1.  S DFN=0
  1.  F  S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN  D
  1.  . I $P(^BQICARE(OWNR,1,PLIEN,40,DFN,0),U,2)="R" Q
  1.  . Q:$O(^BQIPAT(DFN,10,0))=""
  1.  . S PNAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
  1.  . D RET^BQIFLAG(OWNR,.BQIPREF)
  1.  . Q:'$$FPAT^BQIFLAG(DFN,OWNR,.BQIPREF,DTYP)
  1.  . S ADIEN=0
  1.  . F  S ADIEN=$O(BQIPREF(ADIEN)) Q:'ADIEN  D
  1.  .. ; If the flag entry is inactive, quit
  1.  .. I $P(^BQI(90506,ADIEN,0),"^",2)=1 Q
  1.  .. S ADESC=$P(^BQI(90506,ADIEN,0),U,1)
  1.  .. S FDT=$P(BQIPREF(ADIEN),U,1),TDT=$P(BQIPREF(ADIEN),U,2)
  1.  .. S FDTM=FDT
  1.  .. F  S FDTM=$O(^BQIPAT("AF",DFN,ADIEN,FDTM)) Q:FDTM=""!(FDTM\1>TDT)  D
  1.  ... S ALIEN=0
  1.  ... F  S ALIEN=$O(^BQIPAT("AF",DFN,ADIEN,FDTM,ALIEN)) Q:'ALIEN  D
  1.  .... Q:'$D(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ))
  1.  .... S STAT=+$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,1,DUZ,0),U,2)
  1.  .... ;  if the status is '1' Don't Show and the display type is 'S' don't select
  1.  .... I STAT=1,DTYP="S" Q
  1.  .... I 'STAT,DTYP="H" Q
  1.  .... ;  If the status is 1, set action to "reactivate" and flag status to "hide"
  1.  .... ;  If the status is not 1, set action to "deactivate" and flag status to "show"
  1.  .... S AACT=$S(STAT=1:"S",1:"H"),FSTAT=$S(STAT=1:"H",1:"S")
  1.  .... ;  Get the record ien associated with the flag
  1.  .... S RIEN=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,1)
  1.  .... S ADATM=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,2)
  1.  .... S VIEN=$P(^BQIPAT(DFN,10,ADIEN,5,ALIEN,0),U,4)
  1.  .... S ADATM=$$FMTE^BQIUL1(ADATM\1)
  1.  .... I ADESC["LAB" D
  1.  ..... D LAB^BQIRLB(RIEN)
  1.  ..... S FDESC=TEST_" "_RSLT_" "_RANGE_" "_NRMABN_" "_ORPHY
  1.  .... I ADESC'["LAB" D
  1.  ..... I VIEN="" Q
  1.  ..... NEW NARR
  1.  ..... S FDESC="Provider: "_$$PRV^BQIUL1(VIEN)
  1.  ..... S NARR=$$VVNAR^BQIUL1(VIEN)
  1.  ..... I NARR="" S NARR=$$VPNAR^BQIUL1(VIEN)
  1.  ..... S FDESC=FDESC_$C(13)_$C(10)_"POVs: "_NARR
  1.  .... S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
  1.  .... S PTSEX=$$GET1^DIQ(2,DFN_",",.02,"I")
  1.  .... S PTAGE=$$AGE^BQIAGE(DFN,,1)
  1.  .... S SENS=$$SENS^BQIULPT(DFN)
  1.  .... S HRN=$$HRNL^BQIULPT(DFN),HRN=$TR(HRN,";",$C(10))
  1.  .... S II=II+1
  1.  .... S @DATA@(II)=ADIEN_"^"_ALIEN_"^"_DFN_"^"_PNAME_"^"_HRN_"^"_$P($$DPCP^BQIULPT(DFN),"^",2)_"^"_ADESC_"^"_ADATM_"^"_AACT_"^"_FSTAT_"^"_$G(FDESC)_"^"_DOB_"^"_SENS_"^"_PTSEX_"^"_PTAGE_$C(30)
  1.  Q
  1.  ;
  1. SHR(SHRU,SDFN) ;EP - Is patient in a shared panel?
  1.  N USR,SFLG,SPLIEN,SHAXCS,SHSTDT,SHENDT
  1.  S USR="",SFLG=0
  1.  F  S USR=$O(^BQICARE("C",SHRU,USR)) Q:USR=""  D  Q:SFLG
  1.  . S SPLIEN=""
  1.  . F  S SPLIEN=$O(^BQICARE("C",SHRU,USR,SPLIEN)) Q:SPLIEN=""  D  Q:SFLG
  1.  .. I '$D(^BQICARE(USR,1,SPLIEN,40,"B",SDFN)) Q
  1.  .. I $P(^BQICARE(USR,1,SPLIEN,40,SDFN,0),U,2)="R" Q
  1.  .. S SHAXCS=$P(^BQICARE(USR,1,SPLIEN,30,SHRU,0),U,2)
  1.  .. S SHSTDT=$P(^BQICARE(USR,1,SPLIEN,30,SHRU,0),U,3)
  1.  .. S SHENDT=$P(^BQICARE(USR,1,SPLIEN,30,SHRU,0),U,4)
  1.  .. I SHSTDT'>DT,((SHENDT'<DT)!(SHENDT="")),SHAXCS'="I" S SFLG=1
  1.  Q SFLG
  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