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

BQIGPRA1.m

Go to the documentation of this file. 
  1. BQIGPRA1 ;PRXM/HC/ALA - GPRA RPC Call continued ; 13 Jan 2006  10:35 AM
  1.  ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1.  Q
  1.  ;
  1. PNL(DATA,OWNR,PLIEN,PLIST) ;EP - BQI GET GPRA RESULTS BY PANEL
  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
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIGPPNL",UID))
  1.  K @DATA
  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 GPRA year for this panel
  1.  NEW DA,IENS,BQIYR,BQIH,BQIY,DFN,NAFLG
  1.  S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
  1.  S BQIYR=$$GET1^DIQ(90505.01,IENS,3.3,"E")
  1.  S BQIH=$$SPM^BQIGPUTL()
  1.  I BQIYR="" S BQIYR=$$GET1^DIQ(90508,BQIH_",",2,"E")
  1.  S BQIY=$$LKP^BQIGPUTL(BQIYR)
  1.  ;  get the global references for the corresponding CRS year
  1.  D GFN^BQIGPUTL(BQIH,BQIY)
  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.  ; If no data was found, generate the header
  1.  I II=0,'$D(@DATA) D STAND()
  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
  1.  ;
  1. PAT(DATA,OWNR,PLIEN,DFN) ;EP - Build record by patient
  1.  NEW GMET,GHDR
  1.  ; if the user is the owner of the panel, use the owner's display order
  1.  I $G(DUZ)=$G(OWNR),$O(^BQICARE(OWNR,1,PLIEN,25,0)) D COWN(OWNR,PLIEN,DFN) G EXIT
  1.  ; if the user is a shared user, use the user's display order
  1.  I $G(DUZ)'=$G(OWNR),$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,25,0)) D NCDUZ(OWNR,PLIEN,DFN) G EXIT
  1.  ; otherwise use the standard display order
  1.  D STAND()
  1.  ;
  1. EXIT ;
  1.  Q
  1.  ;
  1. COWN(OWNR,PLIEN,DFN) ;EP - Get customized display for an owner
  1.  ;Parameters
  1.  ;  DFN = Patient internal entry number
  1.  ;  HEADR = Record header
  1.  ;  STVW  = Panel view definition internal entry number
  1.  ;  VALUE = Record value
  1.  ;
  1.  NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,VAL
  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^D00030HIDE_DOB^"
  1.  S DORD=0
  1.  F  S DORD=$O(^BQICARE(OWNR,1,PLIEN,25,"C",DORD)) Q:'DORD  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^BQICARE(OWNR,1,PLIEN,25,"C",DORD,IEN)) Q:'IEN  D
  1.  .. NEW DA,IENS,STVW
  1.  .. S DA(2)=OWNR,DA(1)=PLIEN,DA=IEN,IENS=$$IENS^DILF(.DA)
  1.  .. S STVW=$$GET1^DIQ(90505.125,IENS,.01,"E"),STVWCD=STVW
  1.  .. NEW SIEN
  1.  .. S SIEN=$O(^BQI(90506.1,"B",STVW,""))
  1.  .. ;NEW STVW
  1.  .. ;S STVW=SIEN
  1.  .. ;I $P(^BQI(90506.1,SIEN,2),U,1)="D" S STVW=SIEN D CVAL
  1.  .. I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient" S STVW=SIEN D CVAL
  1.  .. ;I $P(^BQI(90506.1,SIEN,2),U,1)="G" S STVW=STVWCD D GVAL
  1.  .. I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Performance" S STVW=STVWCD D GVAL
  1.  .. S VALUE=VALUE_VAL_"^"
  1.  .. S HEADR=HEADR_HDR_"^"
  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. NCDUZ(OWNR,PLIEN,DFN) ;EP - Get customized display for a shared user
  1.  ; New (in DEV) CDUZ
  1.  NEW IEN,HDR,VALUE,HEADR,DORD,HDOB,Y,VAL
  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^D00030HIDE_DOB^"
  1.  S IEN=0
  1.  F  S IEN=$O(^BQICARE(OWNR,1,PLIEN,30,DUZ,25,IEN)) Q:'IEN  D
  1.  . NEW DA,IENS,STVW
  1.  . S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=DUZ,DA=IEN
  1.  . S IENS=$$IENS^DILF(.DA)
  1.  . S STVW=$$GET1^DIQ(90505.325,IENS,.01,"I"),STVWCD=STVW
  1.  . NEW SIEN
  1.  . S SIEN=$O(^BQI(90506.1,"B",STVW,""))
  1.  . ;I $P(^BQI(90506.1,SIEN,2),U,1)="D" S STVW=SIEN D CVAL
  1.  . I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Patient" S STVW=SIEN D CVAL
  1.  . ;I $P(^BQI(90506.1,SIEN,2),U,1)="G" S STVW=STVWCD D GVAL
  1.  . I $$GET1^DIQ(90506.1,SIEN_",",3.01,"E")="Performance" S STVW=STVWCD D GVAL
  1.  . S VALUE=VALUE_VAL_"^"
  1.  . S HEADR=HEADR_HDR_"^"
  1.  ;
  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. STAND() ;EP - Get standard display
  1.  NEW IEN,HDR,VALUE,HEADR,SENS,HDOB,Y,VER,VAL
  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^D00030HIDE_DOB^"
  1.  S IEN=0
  1.  F  S IEN=$O(^BQI(90506.1,"AC","D",IEN)) Q:IEN=""  D
  1.  . S STVW=IEN
  1.  . ; For a standard display, only display the 'R'equired fields.
  1.  . I $$GET1^DIQ(90506.1,STVW_",",3.04,"I")'="O" D
  1.  .. D CVAL
  1.  .. S VALUE=VALUE_VAL_"^"
  1.  .. S HEADR=HEADR_HDR_"^"
  1.  ;
  1.  I $G(BQIMEASF)="" D INP^BQINIGHT
  1.  S IEN=0
  1.  F  S IEN=$O(^BQI(90506.1,"AC","G",IEN)) Q:IEN=""  D
  1.  . S STVW=$P(^BQI(90506.1,IEN,0),U,1)
  1.  . I $P(STVW,"_",1)'=BQIYR Q
  1.  . I $P(^BQI(90506.1,IEN,0),U,10)=1 Q
  1.  . S GIEN=$P(STVW,"_",2)
  1.  . S VER=$$VERSION^XPDUTL("BGP")
  1.  . I $$GET1^DIQ(90506.1,IEN_",",3.04,"I")'="O" D
  1.  .. I VER<8.0 D
  1.  ... S PGIEN=$O(^BQI(90508,BQIH,20,BQIY,20,"B",GIEN,"")) I PGIEN="" Q
  1.  ... S NAFLG=+$P(^BQI(90508,BQIH,20,BQIY,20,PGIEN,0),U,4)
  1.  .. I VER>7.0 D
  1.  ... S NAFLG=$$GET1^DIQ(BQIMEASF,GIEN_",",1704,"I")
  1.  ... S NAFLG=$S(NAFLG="Y":1,1:0)
  1.  .. D GVAL
  1.  .. S VALUE=VALUE_VAL_"^"
  1.  .. S HEADR=HEADR_HDR_"^"
  1.  ;
  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.  Q
  1.  ;
  1. CVAL ; Get demographic 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 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. GVAL ;EP - Get GPRA value for patient
  1.  NEW PIEN,DEN,NUM,SPVW,SPIEN,VER,BQIDOD
  1.  I $G(BQIMEASF)="" D INP^BQINIGHT
  1.  I $G(DFN)="" S VAL="",HDR="T00003"_STVW,GMET="" Q
  1.  S BQIDOD=$$GET1^DIQ(2,DFN_",",.351,"I") ; Is patient deceased?
  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.  I VER<8.0 D
  1.  . S SPIEN=$O(^BQI(90508,BQIH,20,BQIY,20,"B",SPVW,"")) I SPIEN="" Q
  1.  . S NAFLG=+$P(^BQI(90508,BQIH,20,BQIY,20,SPIEN,0),"^",4)
  1.  ;
  1.  I VER>7.0 D
  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