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

BQITDPNL.m

Go to the documentation of this file. 
  1. BQITDPNL ;PRXM/HC/ALA-Get Patient Tags by Panel ; 20 Nov 2007  2:20 PM
  1.  ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1. EN(DATA,OWNR,PLIEN,PLIST) ;EP - BQI GET DX CAT BY PANEL
  1.  ;Input
  1.  ;  OWNR  - Owner of panel internal entry number
  1.  ;  PLIEN - Panel internal entry number
  1.  ;  PLIST - List of patient DFNs (optional)
  1.  ;Output
  1.  ;  DATA  - name of global (passed by reference) in which the data
  1.  ;          is stored
  1.  NEW UID,II
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQITDPNL",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITDPNL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  ;S @DATA@(II)="I00010DFN^T00030PATIENT_NAME^T00030HRN^D00030DOB^T00010AGE^T00001SEX^D00030DOD^"
  1.  S @DATA@(II)="I00010DFN^T00030PATIENT_NAME^T00030HRN^D00030DOB^T00010AGE^T00001SENS_FLAG^"
  1.  S @DATA@(II)=@DATA@(II)_"T00035TAG_NAME^I00010TAG_IEN^T00015STATUS^D00030DATE_LASTUPDATE^T00035UPDATED_BY^T00050COMMENT^T01024OTHER_COMMENT"_$C(30)
  1.  ;
  1.  NEW BQIDFN,DEMOG,BQI,BN,LIST
  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 BQIDFN=$P(PLIST,$C(28),BQI) Q:BQIDFN=""  D
  1.  .. I $P(^BQICARE(OWNR,1,PLIEN,40,BQIDFN,0),"^",2)="R" Q
  1.  .. D PPAT(BQIDFN,2)
  1.  ;
  1.  S BQIDFN=0
  1.  F  S BQIDFN=$O(^BQICARE(OWNR,1,PLIEN,40,BQIDFN)) Q:'BQIDFN  D
  1.  . I $P(^BQICARE(OWNR,1,PLIEN,40,BQIDFN,0),U,2)="R" Q
  1.  . D PPAT(BQIDFN,2) ; Retrieve all tags regardless of status
  1.  . ;D PPAT(BQIDFN)
  1.  ;
  1. DONE ; Finish the RPC call
  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. PPAT(BQIDFN,INC) ; Get data by patient
  1.  NEW DEMOG,TIEN,QFL,TAGIEN,TAGNM,STAT,TAGDTU,WHO,SCOM,OCOM,OCN,BQIDOD
  1.  S DEMOG=$P($$GETDATA^BQITDLST(BQIDFN),U,1,5)_U_$$SENS^BQIULPT(BQIDFN)
  1.  S BQIDOD=$$GET1^DIQ(2,BQIDFN_",",.351,"I")
  1.  S INC=$G(INC,0)
  1.  I $O(^BQIPAT(BQIDFN,20,0))="",$O(^BQIREG("AC",BQIDFN,""))="" D  Q
  1.  . S II=II+1,@DATA@(II)=DEMOG_U_$S(BQIDOD'="":"{D}",1:"{None}")_U_U_U_U_$C(30)
  1.  . ;S II=II+1,@DATA@(II)=$P(DEMOG,U,1,6)_U_"{None}"_U_U_U_U_$C(30)
  1.  ;
  1.  ; if searching for active tags and person has no active tags
  1.  I 'INC,'$$ACT^BQITDUTL(BQIDFN) S II=II+1,@DATA@(II)=DEMOG_U_$S(BQIDOD'="":"{D}",1:"{None}")_U_U_U_U_$C(30) Q
  1.  ;I 'INC,'$$ACT^BQITDUTL(BQIDFN) S II=II+1,@DATA@(II)=$P(DEMOG,U,1,6)_U_"{None}"_U_U_U_U_$C(30) Q
  1.  ;
  1.  S TIEN="",QFL=0
  1.  F  S TIEN=$O(^BQIREG("AC",BQIDFN,TIEN)) Q:TIEN=""  D
  1.  . D TAG(TIEN,INC,1)
  1.  Q
  1.  ;
  1. TAG(IEN,INC,FULL) ;EP - Get current tag data
  1.  ; Check status
  1.  ; INC - if set to 0 only include tag if active
  1.  ;       if set to 1 only include tag if active or Not Accepted tags
  1.  ;       if set to anything else include tag regardless of status
  1.  ; FULL  if set to 0, don't include full demographics
  1.  ;       if set to 1, include full demographics
  1.  ;
  1.  S TAGIEN=$$GET1^DIQ(90509,IEN_",",.01,"I")
  1.  S TAGNM=$$GET1^DIQ(90509,IEN_",",.01,"E")
  1.  S STAT=$$GET1^DIQ(90509,IEN_",",.03,"I")
  1.  I $G(INC)=0 I STAT'="A",STAT'="P" Q
  1.  I $G(INC)=1 I STAT'="A",STAT'="P",STAT'="N" Q
  1.  S FULL=$G(FULL,0)
  1.  S TAGDTU=$P(^BQIREG(IEN,0),U,4)
  1.  S TAGDTU=$$FMTE^BQIUL1(TAGDTU)
  1.  S WHO=$P(^BQIREG(IEN,0),U,5)
  1.  S SCOM=$$GET1^DIQ(90509,IEN_",",.06,"I")
  1.  S OCOM=""
  1.  S OCN=0
  1.  F  S OCN=$O(^BQIREG(IEN,1,OCN)) Q:'OCN  D
  1.  . S OCOM=OCOM_^BQIREG(IEN,1,OCN,0)_" "
  1.  I FULL S II=II+1,@DATA@(II)=DEMOG_U_TAGNM_U_TAGIEN_U_STAT_U_TAGDTU_U_WHO_U_SCOM_U_OCOM_$C(30)
  1.  I 'FULL S II=II+1,@DATA@(II)=$P(DEMOG,U,1,5)_U_TAGNM_U_TAGIEN_U_STAT_U_TAGDTU_U_WHO_U_SCOM_U_OCOM_$C(30)
  1.  Q
  1.  ;
  1. PAT(DATA,DFN) ;EP - BQI GET DX CAT BY PATIENT
  1.  NEW UID,II
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQITDPT",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITDPNL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="I00010DFN^T00030PATIENT_NAME^T00030HRN^D00030DOB^T00010AGE^T00035TAG_NAME^I00010TAG_IEN^T00015STATUS^"
  1.  S @DATA@(II)=@DATA@(II)_"D00030DATE_LASTUPDATE^T00035UPDATED_BY^T00050COMMENT^T01024OTHER_COMMENT"_$C(30)
  1.  ;
  1.  D PPAT(DFN,1)
  1.  G DONE