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

BQIPLDS1.m

Go to the documentation of this file. 
  1. BQIPLDS1 ;PRXM/HC/ALA-Panel Description Utility (cont) ; 7 Apr 2008  4:28 PM
  1.  ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
  1.  ;
  1.  Q
  1.  ;
  1. FILTER(OWNR,PLIEN) ;EP - Include filter description
  1.  ;
  1.  ; Retrieve all filters for this panel and return as a string in filter order
  1.  ; as defined in the ICARE DEFINITIONS file (90506.03,.1)
  1.  ;
  1.  N DA,FIENS,FSOURCE,FIEN,FN,FPARMS,FMPARMS,FILTER
  1.  N AFILTER,AP,AFPARMS,AFMPARMS,MAP
  1.  S DA(1)=OWNR,DA=PLIEN,FIENS=$$IENS^DILF(.DA)
  1.  S FSOURCE=$$GET1^DIQ(90505.01,FIENS,.14,"E")
  1.  ; if there is no filter source, the filter may have been turned off
  1.  I FSOURCE="" Q ""
  1.  S FIEN=$$PP^BQIDCDF(FSOURCE) ; Filter ien
  1.  I FIEN=-1 S BMXSEC="Filter SOURCE was not found" Q ""
  1.  ; Get filters from panel definition
  1.  S FN=0 F  S FN=$O(^BQICARE(OWNR,1,PLIEN,15,FN)) Q:'FN  D
  1.  . NEW DA,IENS,FNAME,VALUE,BQFIL
  1.  . S DA(2)=OWNR,DA(1)=PLIEN,DA=FN,IENS=$$IENS^DILF(.DA)
  1.  . S FNAME=$$GET1^DIQ(90505.115,IENS,.01,"E") Q:FNAME=""  S FILTER(FNAME)=""
  1.  . S PTYP=$$PTYP^BQIDCDF(FSOURCE,FNAME)
  1.  . S VALUE=$$GVAL(PTYP,90505.115,IENS,FSOURCE,FNAME)
  1.  . I VALUE'="" D  Q
  1.  .. S FPARMS(FNAME)=VALUE
  1.  .. ; Retrieve associated parameters
  1.  .. ; Single associated parameter
  1.  .. S AP=0
  1.  .. F  S AP=$O(^BQICARE(OWNR,1,PLIEN,15,FN,2,AP)) Q:'AP  D
  1.  ... NEW DA,IENS,APNAME,AVALUE,APTYP
  1.  ... S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=FN,DA=AP,IENS=$$IENS^DILF(.DA)
  1.  ... S APNAME=$$GET1^DIQ(90505.1152,IENS,.01,"E") Q:APNAME=""  S AFILTER(FNAME,APNAME)=""
  1.  ... S APTYP=$$PTYP^BQIDCDF(FSOURCE,APNAME)
  1.  ... S AVALUE=$$GVAL(APTYP,90505.1152,IENS,FSOURCE,APNAME)
  1.  ... I $T(@(APNAME))'="" D @APNAME
  1.  ... I AVALUE'="" S AFPARMS(FNAME,VALUE,APNAME)=AVALUE
  1.  ... I AVALUE="" D
  1.  .... Q:'$D(^BQICARE(OWNR,1,PLIEN,15,FN,2,AP,1))
  1.  .... ; Multiple associated parameter
  1.  .... S MAP=0
  1.  .... F  S MAP=$O(^BQICARE(OWNR,1,PLIEN,15,FN,2,AP,1,MAP)) Q:'MAP  D
  1.  ..... NEW DA,IENS
  1.  ..... S DA(4)=OWNR,DA(3)=PLIEN,DA(2)=FN,DA(1)=AP,DA=MAP,IENS=$$IENS^DILF(.DA)
  1.  ..... S AVALUE=$$GET1^DIQ(90505.11521,IENS,.01,"E")
  1.  ..... I $T(@(APNAME))'="" D @APNAME
  1.  ..... I AVALUE'="" S AFPARMS(FNAME,VALUE,APNAME,AVALUE)=""
  1.  . I VALUE="" D
  1.  .. Q:'$D(^BQICARE(OWNR,1,PLIEN,15,FN,1))
  1.  .. NEW MN
  1.  .. S MN=0 F  S MN=$O(^BQICARE(OWNR,1,PLIEN,15,FN,1,MN)) Q:'MN  D
  1.  ... NEW DA,IENS,VALUE,BQFIL
  1.  ... S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=FN,DA=MN,IENS=$$IENS^DILF(.DA)
  1.  ... S VALUE=$$GMVAL(PTYP,90505.1151,IENS,FSOURCE,FNAME)
  1.  ... I VALUE'="" S FMPARMS(FNAME,VALUE)=""
  1.  ... ; Retrieve associated parameters
  1.  ... ; Single associated parameter
  1.  ... S AP=0
  1.  ... F  S AP=$O(^BQICARE(OWNR,1,PLIEN,15,FN,1,MN,2,AP)) Q:'AP  D
  1.  .... NEW DA,IENS,APNAME,AVALUE,APTYP
  1.  .... S DA(4)=OWNR,DA(3)=PLIEN,DA(2)=FN,DA(1)=MN,DA=AP,IENS=$$IENS^DILF(.DA)
  1.  .... S APNAME=$$GET1^DIQ(90505.11512,IENS,.01,"E") Q:APNAME=""  S AFILTER(FNAME,APNAME)=""
  1.  .... S APTYP=$$PTYP^BQIDCDF(FSOURCE,APNAME)
  1.  .... S AVALUE=$$GVAL(APTYP,90505.11512,IENS,FSOURCE,APNAME)
  1.  .... I $T(@(APNAME))'="" D @APNAME
  1.  .... I AVALUE'="" S AFMPARMS(FNAME,VALUE,APNAME,AVALUE)=""
  1.  .... I AVALUE="" D
  1.  ..... Q:'$D(^BQICARE(OWNR,1,PLIEN,15,FN,1,MN,2,AP,1))
  1.  ..... ; Multiple associated parameter
  1.  ..... S MAP=0
  1.  ..... F  S MAP=$O(^BQICARE(OWNR,1,PLIEN,15,FN,1,MN,2,AP,1,MAP)) Q:'MAP  D
  1.  ...... NEW DA,IENS
  1.  ...... S DA(5)=OWNR,DA(4)=PLIEN,DA(3)=FN,DA(2)=MN,DA(1)=AP,DA=MAP,IENS=$$IENS^DILF(.DA)
  1.  ...... S AVALUE=$$GET1^DIQ(90505.115121,IENS,.01,"E")
  1.  ...... I $T(@(APNAME))'="" D @APNAME
  1.  ...... I AVALUE'="" S AFMPARMS(FNAME,VALUE,APNAME,AVALUE)=""
  1.  ; Load description and executable code
  1.  N X,DIC,Y,FX,FDES,FORD,FDESC,DA,IENS
  1.  S FNAME="",FDESC=""
  1.  F  S FNAME=$O(FILTER(FNAME)) Q:FNAME=""  D
  1.  . S X=FNAME,DIC(0)="NZ",DIC="^BQI(90506,"_FIEN_",3," D ^DIC
  1.  . Q:Y<0  S DA=$P(Y,"^"),DA(1)=FIEN,IENS=$$IENS^DILF(.DA)
  1.  . S FX=$$GET1^DIQ(90506.03,IENS,2,"I")
  1.  . I FX'="" X FX
  1.  . S FDES=$$GET1^DIQ(90506.03,IENS,4,"I")
  1.  . S FORD=$$GET1^DIQ(90506.03,IENS,.1,"I")
  1.  . Q:FORD=""
  1.  . I FDES'="" S FDES(FORD)=FDES
  1.  S FORD="" F  S FORD=$O(FDES(FORD)) Q:FORD=""  S FDESC=FDESC_FDES(FORD)_"; "
  1.  ;S FDESC=$E(FDESC,1,$L(FDESC)-2) ; Remove trailing "; "
  1.  S FDESC=$$TKO^BQIUL1(FDESC,"; ")
  1.  I $D(AFPARMS) D
  1.  . N CAT,AVAL,TP,VALS,FDSC
  1.  . S CAT=""
  1.  . F  S CAT=$O(FPARMS(CAT)) Q:CAT=""  I FPARMS(CAT)'="",$D(AFPARMS(CAT,FPARMS(CAT))) D
  1.  .. S TP=""
  1.  .. F  S TP=$O(AFPARMS(CAT,FPARMS(CAT),TP)) Q:TP=""  D
  1.  ... S AVAL="",VALS=$$GDSC(TP,FIEN)
  1.  ... F  S AVAL=$O(AFPARMS(CAT,FPARMS(CAT),TP,AVAL)) Q:AVAL=""  D
  1.  .... S VALS=VALS_AVAL_", "
  1.  ... S VALS=$$TKO^BQIUL1(VALS,", ")
  1.  .. I VALS'="" S FPARMS(CAT)=FPARMS(CAT)_" ("_VALS_")"
  1.  I $D(FMPARMS) D
  1.  . S FNAME=""
  1.  . F  S FNAME=$O(FMPARMS(FNAME)) Q:FNAME=""  D
  1.  .. S VAL="",VALS=""
  1.  .. F  S VAL=$O(FMPARMS(FNAME,VAL)) Q:VAL=""  D
  1.  ... S VALS=VALS_VAL_$$ADDAP(FNAME,VAL)_", "
  1.  .. S VALS=$$TKO^BQIUL1(VALS,", ")
  1.  .. S FPARMS(FNAME)=VALS
  1.  I FDESC["|" D
  1.  . F  S FDESC=$P(FDESC,"|",1)_$G(FPARMS($P(FDESC,"|",2)))_$P(FDESC,"|",3,99) Q:FDESC'["|"
  1.  I FDESC'="" S FDESC=$$TKO^BQIUL1(FDESC,", ")
  1.  Q FDESC
  1.  ;
  1. GVAL(PTYP,FILN,IENS,SRC,NM) ; EP - Get value of parameter/filter
  1.  N VALUE,BQFIL
  1.  I PTYP="T" D
  1.  . S VALUE=$$GET1^DIQ(FILN,IENS,.03,"E")
  1.  . S BQFIL=$$FILN^BQIDCDF(SRC,NM) Q:BQFIL=""
  1.  . S VALUE=$$GET1^DIQ(BQFIL,VALUE,.01,"E")
  1.  I PTYP'="T" S VALUE=$$GET1^DIQ(FILN,IENS,.02,"E")
  1.  I PTYP="D" S VALUE=$$UP^XLFSTR($$FMTE^XLFDT(VALUE,1))
  1.  I PTYP="R" D
  1.  . S VALUE=$$DATE^BQIUL1(VALUE)
  1.  . S VALUE=$$UP^XLFSTR($$FMTE^XLFDT(VALUE,1))
  1.  Q VALUE
  1.  ;
  1. GMVAL(PTYP,FILN,IENS,SRC,NM) ; EP - Get value for multiples
  1.  N VALUE,BQFIL
  1.  I PTYP="T" D
  1.  . S VALUE=$$GET1^DIQ(FILN,IENS,.02,"E")
  1.  . S BQFIL=$$FILN^BQIDCDF(SRC,NM) Q:BQFIL=""
  1.  . S VALUE=$$GET1^DIQ(BQFIL,VALUE,.01,"E")
  1.  I PTYP'="T" S VALUE=$$GET1^DIQ(FILN,IENS,.01,"E")
  1.  Q VALUE
  1.  ;
  1. GDSC(CAT,FIEN) ; EP - Get filter description
  1.  N X,DIC,Y,DA,IENS
  1.  S X=CAT,DIC(0)="NZ",DIC="^BQI(90506,"_FIEN_",3," D ^DIC
  1.  I Y<0 Q ""
  1.  S DA=$P(Y,"^"),DA(1)=FIEN,IENS=$$IENS^DILF(.DA)
  1.  S FDSC=$$GET1^DIQ(90506.03,IENS,.09,"I")
  1.  I FDSC'="" S FDSC=FDSC_" "
  1.  Q FDSC
  1.  ;
  1. ADDAP(FNM,VALUE) ; EP - Return associated parameters text for multiple filter
  1.  N TP,AVAL,VALS
  1.  S (TP,VALS)=""
  1.  F  S TP=$O(AFMPARMS(FNM,VALUE,TP)) Q:TP=""  D
  1.  . S VALS=VALS_" ("_$$GDSC(TP,FIEN),AVAL="" D
  1.  .. F  S AVAL=$O(AFMPARMS(FNM,VALUE,TP,AVAL)) Q:AVAL=""  D
  1.  ... S VALS=VALS_AVAL_", "
  1.  .. S VALS=$$TKO^BQIUL1(VALS,", ")_")"
  1.  Q VALS
  1.  ;
  1. DXSTAT ; EP - Translate code to description for dx tag statuses
  1.  S AVALUE=$S(AVALUE="A":"Accepted",AVALUE="P":"Proposed",AVALUE="N":"Not Accepted",AVALUE="V":"No Longer Valid",AVALUE="S":"Superseded",1:"")
  1.  Q
  1.  ;
  1. MYPT(OWNR,MPIEN,ICDEF,PARMS,MPARMS) ;EP - Set up My Patients - System Generated Description
  1.  ;
  1.  ;Description: This tag gets called by DESCRIPTION EXECUTABLE code in 90506. The process is
  1.  ;             started from PEN^BQIPLDSC. It sets up the single field PARMS array and the
  1.  ;             multiple field MPARMS array with information found in the file 90505, node 7.
  1.  ;
  1.  ;Parameters:
  1.  ;   OWNR = Owner
  1.  ;  MPIEN = File 90505, Node 7 IEN
  1.  ;  ICDEF = ICARE DEFINITIONS Name
  1.  ;  PARMS = Array of Fields and Values (Updated By This Tag)
  1.  ; MPARMS = Array of Multiple Fields and Values (Updated By This Tag)
  1.  ;
  1.  NEW DA,IENS,N,SOURCE
  1.  S SOURCE="PATIENTS ASSIGNED TO" ;Use the field defs from PATIENTS ASSIGNED TO since they are the same
  1.  S N=0 F  S N=$O(^BQICARE(OWNR,7,MPIEN,10,N)) Q:'N  D
  1.  . NEW DA,IENS,NAME,DESCEX,VALUE,PPIEN,PTYP,BQFIL
  1.  . S DA(2)=OWNR,DA(1)=MPIEN,DA=N,IENS=$$IENS^DILF(.DA)
  1.  . S NAME=$$GET1^DIQ(90505.08,IENS,.01,"E")
  1.  . ;
  1.  . S PPIEN=$$PP^BQIDCDF(SOURCE)
  1.  . I PPIEN S DESCEX=$$GET1^DIQ(90506,PPIEN,5,"I")
  1.  . S PTYP=$$PTYP^BQIDCDF(SOURCE,NAME)
  1.  . I PTYP="T" D
  1.  .. S VALUE=$$GET1^DIQ(90505.08,IENS,.03,"E")
  1.  .. S BQFIL=$$FILN^BQIDCDF(SOURCE,NAME) Q:BQFIL=""
  1.  .. S VALUE=$$GET1^DIQ(BQFIL,VALUE,.01,"E")
  1.  . I PTYP'="T" S VALUE=$$GET1^DIQ(90505.08,IENS,.02,"E")
  1.  . ;
  1.  . ;Save Provider
  1.  . I NAME="PROV" D  Q
  1.  .. I '$D(PARMS("PROV")) S PARMS("PROV")=VALUE
  1.  . ;
  1.  . ;Save Single-Stored Specialty
  1.  . I NAME="SPEC",VALUE'="",$G(DESCEX)'="" X DESCEX
  1.  . ;
  1.  . ;Handle Multiple Fields
  1.  . I VALUE="",$D(^BQICARE(OWNR,7,MPIEN,10,N,1)) D  Q
  1.  .. ;
  1.  .. NEW MN
  1.  .. S MN=0 F  S MN=$O(^BQICARE(OWNR,7,MPIEN,10,N,1,MN)) Q:'MN  D
  1.  ... NEW DA,IENS,VALUE
  1.  ... S DA(3)=OWNR,DA(2)=MPIEN,DA(1)=N,DA=MN,IENS=$$IENS^DILF(.DA)
  1.  ... I PTYP="T" D
  1.  .... S VALUE=$$GET1^DIQ(90505.81,IENS,.02,"E")
  1.  .... S BQFIL=$$FILN^BQIDCDF(SOURCE,NAME) Q:BQFIL=""
  1.  .... S VALUE=$$GET1^DIQ(BQFIL,VALUE,.01,"E")
  1.  ... I PTYP'="T" S VALUE=$$GET1^DIQ(90505.81,IENS,.01,"E")
  1.  ... I VALUE'="",$G(DESCEX)'="" X DESCEX
  1.  ... S MPARMS(NAME,VALUE)=""
  1.  . ;
  1.  . ;Save Single fields
  1.  . S PARMS(NAME)=VALUE
  1.  ;
  1.  I $D(PARMS("VISITS")),$D(PARMS("TMFRAME")) D
  1.  . I ICDEF="MY PATIENTS-PRIMARY" D PSVST("PRIM",$G(PARMS("VISITS")),$G(PARMS("TMFRAME")),.MPARMS)
  1.  . I ICDEF="MY PATIENTS-PRIMARY/SECONDARY" D PSVST("PRSC",$G(PARMS("VISITS")),$G(PARMS("TMFRAME")),.MPARMS)
  1.  . K PARMS("VISITS"),PARMS("TMFRAME")
  1.  Q
  1.  ;
  1. SPEC ;EP - Format Specialty provider
  1.  I NAME'="SPEC" Q
  1.  I VALUE="" Q
  1.  N SPECNM
  1.  S SPECNM=$$GET1^DIQ(90360.3,VALUE,.01,"I")
  1.  I SPECNM="" Q
  1.  ;
  1.  ;Save each Specialty name in the "TYPE" node so it gets included in the
  1.  ;generated description. The "SPEC" entry also needs removed so it doesn't show
  1.  ;up as well.
  1.  K:$D(MPARMS("TYPE","SPEC")) MPARMS("TYPE","SPEC")
  1.  S MPARMS("TYPE",SPECNM)=""
  1.  Q
  1.  ;
  1. PSVST(BQITYPE,BQIVST,BQITIME,BQIMPRM) ;EP - Assemble Primary/Secondary Provider Visit Checks
  1.  ;
  1.  ;Description: This tag receives primary or secondary visit check information and moves it into
  1.  ;             the multiple field "TYPE" node so it will be included with the other specialties.
  1.  ;
  1.  ;Parameters:
  1.  ;BQITYPE = "PRIM" - Primary or "PRSC" - Primary/Secondary
  1.  ;BQIVST = # of visits parameter
  1.  ;BQITIME = Date Range
  1.  ;BQIMPRM = Passed in MPARMS array. Gets updated with visit check description
  1.  ;
  1.  ;
  1.  N STR
  1.  I BQITYPE=""!(BQIVST="")!(BQITIME="") Q
  1.  ;
  1.  ;Remove Existing Entry
  1.  K BQIMPRM("TYPE",BQITYPE)
  1.  ;
  1.  ;Assemble Visit Check Description
  1.  S STR=$S(BQITYPE="PRIM":"PRIMARY VISIT PROVIDER",1:"PRIMARY/SECONDARY VISIT PROVIDER")
  1.  S STR=STR_" "_BQIVST_$S(BQIVST>1:" VISITS",1:" VISIT")
  1.  S STR=STR_" IN "_$S(BQITIME="T-24M":"2 YRS",BQITIME="T-12M":"1 YR",1:$P(BQITIME,"T-",2))
  1.  ;
  1.  ;Save New Entry With Visit Check Description
  1.  S BQIMPRM("TYPE",STR)=""
  1.  Q