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

BQIPLVWP.m

Go to the documentation of this file. 
  1. BQIPLVWP ;PRXM/HC/ALA-Get Patient Data by View ; 17 Oct 2005  4:49 PM
  1.  ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
  1.  ;
  1.  Q
  1.  ;
  1. EN(DATA,OWNR,PLIEN,DFN) ;EP - Starting point
  1.  ;
  1.  ;Description
  1.  ;  Builds the header and data string in the panel
  1.  ;  display order.  If a customized view exists, it
  1.  ;  builds it, otherwise it builds the standard.
  1.  ;Input
  1.  ;  OWNR  - owner of the panel
  1.  ;  PLIEN - panel internal entry number
  1.  ;  PLIST - List of patient IENs separated by $C(28)
  1.  ;  DATA  - Global reference
  1.  ;Expects
  1.  ;  DUZ   - person signed onto system
  1.  ;  II    - counter variable
  1.  ;
  1.  ; if the user is the owner of the panel, use the owner's display order
  1.  NEW BQI,CTYP,SRC,HEADR,VALUE,QFL,KEY,VCODE
  1.  S CTYP="D",SRC=$O(^BQI(90506.5,"C",CTYP,""))
  1.  S HEADR="I00010DFN^T00001TICKLER_INDICATOR^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^",VALUE=""
  1.  I $G(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
  1.  ; Check for template
  1.  NEW DA,IENS,TEMPL,LYIEN,VWIEN
  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 TQFL=0 D  G FIN:'TQFL
  1.  . S LYIEN=$$TPN^BQILYUTL(DUZ,TEMPL)
  1.  . I LYIEN="" S TQFL=1 Q
  1.  . S DOR=""
  1.  . F  S DOR=$O(^BQICARE(DUZ,15,LYIEN,1,"C",DOR)) Q:DOR=""  D
  1.  .. S VWIEN=""
  1.  .. F  S VWIEN=$O(^BQICARE(DUZ,15,LYIEN,1,"C",DOR,VWIEN)) Q:VWIEN=""  D
  1.  ... S VCODE=$P(^BQICARE(DUZ,15,LYIEN,1,VWIEN,0),U,1)
  1.  ... S GIEN=$O(^BQI(90506.1,"B",VCODE,"")) I GIEN="" Q
  1.  ... S KEY=$$GET1^DIQ(90506.1,GIEN_",",3.1,"E")
  1.  ... I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
  1.  ... S STVW=GIEN
  1.  ... ; if the field has been inactivated, don't get data
  1.  ... I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
  1.  ... D GVAL
  1.  ... S VALUE=VALUE_VAL_"^"
  1.  ... S HEADR=HEADR_HDR_"^"
  1.  ... K VAL,HDR
  1.  ;
  1.  ; If no template, check for customized
  1.  ;
  1.  I OWNR=DUZ D
  1.  . S VWIEN=0,CIEN=$O(^BQICARE(OWNR,1,PLIEN,20,VWIEN))
  1.  . I CIEN'="" D  Q
  1.  .. F  S VWIEN=$O(^BQICARE(OWNR,1,PLIEN,20,VWIEN)) Q:'VWIEN  D
  1.  ... NEW DA,IENS,STVW
  1.  ... S DA(2)=OWNR,DA(1)=PLIEN,DA=VWIEN,IENS=$$IENS^DILF(.DA)
  1.  ... S VCODE=$$GET1^DIQ(90505.05,IENS,.01,"I")
  1.  ... S STVW=$O(^BQI(90506.1,"B",VCODE,"")) I STVW="" Q
  1.  ... ; if the field has been inactivated, don't get data
  1.  ... I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
  1.  ... ; if the source does not match, quit
  1.  ... I $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC Q
  1.  ... S KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
  1.  ... I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
  1.  ... D GVAL
  1.  ... S VALUE=VALUE_VAL_"^"
  1.  ... S HEADR=HEADR_HDR_"^"
  1.  ... K VAL,HDR
  1.  . ;
  1.  . ; If no customized found, use default
  1.  . I CIEN="" D STAND()
  1.  ;
  1.  I OWNR'=DUZ D
  1.  . S VWIEN=0,CIEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,VWIEN))
  1.  . I CIEN'="" D  Q
  1.  .. F  S VWIEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,20,VWIEN)) Q:'VWIEN  D
  1.  ... NEW DA,IENS,STVW
  1.  ... S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,DA=VWIEN
  1.  ... S IENS=$$IENS^DILF(.DA)
  1.  ... S VCODE=$$GET1^DIQ(90505.06,IENS,.01,"I")
  1.  ... S STVW=$O(^BQI(90506.1,"B",VCODE,"")) I STVW="" Q
  1.  ... ; if the field has been inactivated, don't get data
  1.  ... I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
  1.  ... ; if the source does not match, quit
  1.  ... I $$GET1^DIQ(90506.1,STVW_",",3.01,"I")'=SRC Q
  1.  ... S KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
  1.  ... I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
  1.  ... D GVAL
  1.  ... S VALUE=VALUE_VAL_"^"
  1.  ... S HEADR=HEADR_HDR_"^"
  1.  ... K VAL,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'="" S II=II+1,@DATA@(II)=VALUE_$C(30) K VALUE
  1.  K HEADR
  1.  Q
  1.  ;
  1. STAND() ;EP - Get standard display
  1.  NEW VWIEN,HDR,SENS
  1.  S HEADR="I00010DFN^T00001TICKLER_INDICATOR^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^",VALUE=""
  1.  I $G(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
  1.  ;
  1.  S ORD=""
  1.  F  S ORD=$O(^BQI(90506.1,"AD","D",ORD)) Q:ORD=""  D
  1.  . S VWIEN=""
  1.  . F  S VWIEN=$O(^BQI(90506.1,"AD","D",ORD,VWIEN)) Q:VWIEN=""  D
  1.  .. S STVW=VWIEN
  1.  .. ; if the field has been inactivated, don't get data
  1.  .. I $$GET1^DIQ(90506.1,STVW_",",.1,"I")=1 Q
  1.  .. S KEY=$$GET1^DIQ(90506.1,STVW_",",3.1,"E")
  1.  .. I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
  1.  .. ; For a standard display,  display the 'R'equired and 'D'efault fields
  1.  .. I $$GET1^DIQ(90506.1,STVW_",",3.04,"I")'="O" D
  1.  ... D GVAL
  1.  ... S VALUE=VALUE_VAL_"^"
  1.  ... S HEADR=HEADR_HDR_"^"
  1.  ... K VAL,HDR
  1.  ;
  1.  Q
  1.  ;
  1. GVAL ; Get 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 VAL=""
  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. PAT(DATA,OWNR,PLIEN,PLIST) ; EP -- BQI GET PATIENT LIST BY DFN
  1.  ;  Get a single patient list record
  1.  NEW UID,II,X
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPLVWP",UID))
  1.  K @DATA
  1.  S II=0,PLIST=$G(PLIST,"")
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLVWP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  D HDR^BQIPLPT
  1.  ;
  1.  I PLIST="" 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.  ;
  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 EN(.DATA,OWNR,PLIEN,.DFN)
  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