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

BQIIPPT.m

Go to the documentation of this file. 
  1. BQIIPPT ;VNGT/HS/ALA-IPC Patient Detail ; 30 Jun 2011  12:32 PM
  1.  ;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
  1.  ;
  1.  ;
  1. EN(DATA,OWNR,PLIEN,CRIPC,PLIST) ;EP - BQI GET IPC PATIENT DETAIL
  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,PGIEN,STVWCD,TDATA
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIGPPNL",UID)) K @DATA
  1.  S TDATA=$NA(^TMP("BQIPTIP",UID)) K @TDATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIGPRA1 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  ;  get the current IPC definition
  1.  S CRIPC=$G(CRIPC,"")
  1.  I CRIPC="" S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
  1.  S CRN=$O(^BQI(90508,1,22,"B",CRIPC,"")) I CRN="" Q
  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.  S II=II+1,@DATA@(II)=$C(31)
  1.  K @TDATA
  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,VAL,BQIDOD,PROV,PAT,CAT,TITLE,MSN
  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_"^"_$$FLG^BQIULPT(DUZ,PLIEN,DFN)_"^"_$$SENS^BQIULPT(DFN)_"^"_$$CALR^BQIULPT(DFN)_"^"_$$MFLAG^BQIULPT(OWNR,PLIEN,DFN)_"^"_HDOB_"^"
  1.  S HEADR="I00010DFN^T00001FLAG_INDICATOR^T00001SENS_FLAG^T00001COMM_FLAG^T00001HIDE_MANUAL^D00030DOB^"
  1.  S HEADR=HEADR_"T00030PN^T00040HRN^T00035DPCP^D00030LVD^D00030LVDPCP^D00030NAPD^"
  1.  I DFN'="" S VAL=$$HRNL^BQIULPT(DFN),VAL=$TR(VAL,";",$C(10))
  1.  I DFN'="" S PROV=$P($$DPCP^BQIULPT(DFN),U,2) I PROV="" S PROV="{NOT ASSIGNED}"
  1.  I DFN'="" S VALUE=VALUE_$P($G(^DPT(DFN,0)),"^",1)_"^"_VAL_"^"_PROV_"^"_$$LVDT^BQIULPT(DFN)_"^"_$$LVDPCP^BQIULPT(DFN)_"^"_$$NAD^BQIULPT(DFN)_"^"
  1.  I DFN'="" S BQIDOD=$$GET1^DIQ(2,DFN_",",.351,"I") ; Is patient deceased?
  1.  ;
  1.  D REC(DFN)
  1.  ;
  1.  I DFN'="" D
  1.  . S PAT=DFN,ORD=""
  1.  . F  S ORD=$O(@TDATA@(PAT,ORD)) Q:ORD=""  D
  1.  .. S VAL=$G(@TDATA@(PAT,ORD,"VAL"))
  1.  .. S HDR=$G(@TDATA@(PAT,ORD,"HDR"))
  1.  .. D UP
  1.  ;
  1.  ; remove trailing up-arrows
  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.  ;
  1.  Q
  1.  ;
  1. GVAL ;EP - Get GPRA value for patient
  1.  NEW PIEN,DEN,NUM,SPVW,SPIEN,VER
  1.  I $G(BQIMEASF)="" D INP^BQINIGHT
  1.  I $G(DFN)="" S VAL="",HDR="T00003"_STVW,GMET="" Q
  1.  S PIEN=$O(^BQIPAT(DFN,30,"B",STVW,""))
  1.  I PIEN="" S VAL=$S(BQIDOD'="":"{D}",1:"NDA"),HDR="T00003"_STVW,GMET="" Q
  1.  ;
  1.  I $G(BQIH)="" S BQIH=$$SPM^BQIGPUTL()
  1.  I $G(BQIYR)="" S BQIYR=$$GET1^DIQ(90508,BQIH_",",2,"E")
  1.  S BQIY=$$LKP^BQIGPUTL(BQIYR)
  1.  ;
  1.  S VER=$$VERSION^XPDUTL("BGP")
  1.  S SPVW=$P(STVW,"_",2),NAFLG=0
  1.  S NAFLG=$$GET1^DIQ(BQIMEASF,SPVW_",",1704,"I")
  1.  S NAFLG=$S(NAFLG="Y":1,1:0)
  1.  ;
  1.  S DEN=$P(^BQIPAT(DFN,30,PIEN,0),U,4)
  1.  S NUM=+$P(^BQIPAT(DFN,30,PIEN,0),U,3)
  1.  ;
  1.  I DEN="" D
  1.  . I NAFLG'=1 S VAL="N/A" Q
  1.  . I 'NUM S VAL=0,GMET=0 Q
  1.  . S VAL=NUM
  1.  I DEN D
  1.  . I 'NUM S VAL="NO",GMET=0 Q
  1.  . S VAL="YES"
  1.  S HDR="T00003"_STVW
  1.  I BQIDOD'="" S VAL="{D}"
  1.  Q
  1.  ;
  1. UP ;EP
  1.  S VALUE=VALUE_$G(VAL)_"^"
  1.  S HEADR=HEADR_HDR_"^"
  1.  Q
  1.  ;
  1. REC(DFN) ;EP - Record
  1.  S ORD=""
  1.  F  S ORD=$O(^BQI(90508,1,22,CRN,1,"C",ORD)) Q:ORD=""  D
  1.  . S MSN=""
  1.  . F  S MSN=$O(^BQI(90508,1,22,CRN,1,"C",ORD,MSN)) Q:'MSN  D
  1.  .. S IDATA=^BQI(90508,1,22,CRN,1,MSN,0)
  1.  .. S CODE=$P(IDATA,U,1),TYP=$P(IDATA,U,2),TITLE=$P(IDATA,U,4),TAB=$P(IDATA,U,13)
  1.  .. I TAB="A" Q
  1.  .. ; If inactive, quit
  1.  .. I $P(IDATA,U,7)=1 Q
  1.  .. S HDR="T00003"_CODE I DFN="" S HEADR=HEADR_HDR_"^" Q
  1.  .. NEW DA,IENS
  1.  .. S DA(2)=1,DA(1)=CRN,DA=MSN,IENS=$$IENS^DILF(.DA)
  1.  .. S CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
  1.  .. S MSIEN=$O(^BQI(90506.1,"B",CODE,""))
  1.  .. I CAT="",MSIEN'="" S CAT=$$GET1^DIQ(90506.1,MSIEN_",",3.03,"E")
  1.  .. I CAT="" S CAT="~"
  1.  .. I $P(IDATA,U,5)'="B" S CAT=CAT_"_2"
  1.  .. I TYP="R",$P(IDATA,U,5)="B" D
  1.  ... K XX
  1.  ... I CODE="IPC_OUTC" D
  1.  .... I DFN'="" S VAL=$$OPAT^BQIIPOTC(CRN,DFN)
  1.  ... I CODE["CTRL" D
  1.  .... I DFN'="" S VAL=$$PAT^BQIIPOTC(CRN,DFN,CODE)
  1.  ... I CODE'="IPC_OUTC",CODE'["CTRL" D
  1.  .... D BUN^BQIIPBNL(CRN,MSN,.XX)
  1.  .... I DFN'="" S VAL=$$PAT^BQIIPBNL(DFN,.XX)
  1.  ... S CAT=CAT_"_1"
  1.  ... D STOR(ORD)
  1.  .. I TYP'="G" Q
  1.  .. S STVW=CODE
  1.  .. D GVAL
  1.  .. D STOR(ORD)
  1.  Q
  1.  ;
  1. STOR(ORD) ;EP
  1.  I DFN="" Q
  1.  S @TDATA@(DFN,ORD,"VAL")=$G(VAL)
  1.  S @TDATA@(DFN,ORD,"HDR")=$G(HDR)
  1.  Q