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

BQIPLPP.m

Go to the documentation of this file. 
  1. BQIPLPP ;PRXM/HC/ALA-Populate a panel based on definition ; 19 Oct 2005  12:26 PM
  1.  ;;2.4;ICARE MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 10
  1.  ;
  1.  Q
  1.  ;
  1. POP(DATA,OWNR,PLIEN,KEEP,OVER) ;EP - BQI POPULATE PANEL
  1.  ; 
  1.  ;Description
  1.  ;  Populate the patient list based on the panel definition
  1.  ;Input
  1.  ;  OWNR  - Owner of panel internal entry number
  1.  ;  PLIEN - Panel internal entry number
  1.  ;  KEEP  - "N" if manual adds/removes should be 'removed' (any other value assumes "Y")
  1.  ;  OVER  - User ien to replace DUZ (90505.01,3.5) if passed 
  1.  ;Output
  1.  ;  DATA  = name of global (passed by reference) in which the data is stored
  1.  ;
  1.  ;  NUMBER OF PATIENTS found if successful or BMXSEC if error.
  1.  ;  Final patient list should have been filed in node 40 of the panel.
  1.  ;
  1.  ; Check if share and has write access
  1.  I $G(BQINIGHT)="",'$$CKSHR^BQIPLSH(OWNR,PLIEN) S BMXSEC="You do not have write access" Q
  1.  ;
  1.  NEW UID,II,TEMP
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP(UID,"BQIPLPP")),TEMP=$NA(^TMP(UID,"BQITEMP"))
  1.  K @DATA,@TEMP
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLPP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  NEW DA,IENS,TYPE,SOURCE,FSOURCE,PPIEN,PTYP,N,NN,PARMS,MPARMS
  1.  NEW EXEC,FEXEC,CNT,QMIEN,ANN,APARMS,MAPARMS
  1.  S KEEP=$G(KEEP)
  1.  S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA),EXEC=""
  1.  S TYPE=$$GET1^DIQ(90505.01,IENS,.03,"I")
  1.  S SOURCE=$$GET1^DIQ(90505.01,IENS,.11,"E")
  1.  S FSOURCE=$$GET1^DIQ(90505.01,IENS,.14,"E")
  1.  S BQIUPD(90505.01,IENS,3.8)=$$NOW^XLFDT()
  1.  ;
  1.  I TYPE="M" G DONE ; Manual type has no requirements for populate.
  1.  ;
  1.  K PARMS,MPARMS
  1.  ;
  1.  ; Get parameters from panel definition
  1.  S N=0 F  S N=$O(^BQICARE(OWNR,1,PLIEN,10,N)) Q:'N  D
  1.  . NEW DA,IENS,NAME,VALUE
  1.  . S DA(2)=OWNR,DA(1)=PLIEN,DA=N,IENS=$$IENS^DILF(.DA)
  1.  . S NAME=$$GET1^DIQ(90505.02,IENS,.01,"E")
  1.  . S PTYP=$$PTYP^BQIDCDF(SOURCE,NAME)
  1.  . I PTYP="T" S VALUE=$$GET1^DIQ(90505.02,IENS,.03,"E")
  1.  . I PTYP'="T" S VALUE=$$GET1^DIQ(90505.02,IENS,.02,"E")
  1.  . I $E(VALUE,1,2)="T-" S VALUE=$$DATE^BQIUL1(VALUE)
  1.  . I VALUE'="",$O(^BQICARE(OWNR,1,PLIEN,10,N,2,0))="" S PARMS(NAME)=VALUE Q
  1.  . I VALUE'="",$O(^BQICARE(OWNR,1,PLIEN,10,N,2,0))'="" D  Q
  1.  .. NEW AN
  1.  .. S AN=0,PARMS(NAME)=VALUE
  1.  .. F  S AN=$O(^BQICARE(OWNR,1,PLIEN,10,N,2,AN)) Q:'AN  D
  1.  ... NEW DA,IENS,ANAME,AVALUE,APTYP
  1.  ... S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=N,DA=AN,IENS=$$IENS^DILF(.DA)
  1.  ... S ANAME=$$GET1^DIQ(90505.22,IENS,.01,"E")
  1.  ... S APTYP=$$PTYP^BQIDCDF(SOURCE,ANAME)
  1.  ... I APTYP="T" S AVALUE=$$GET1^DIQ(90505.22,IENS,.03,"E")
  1.  ... I APTYP'="T" S AVALUE=$$GET1^DIQ(90505.22,IENS,.02,"E")
  1.  ... I $E(AVALUE,1,2)="T-" S AVALUE=$$DATE^BQIUL1(AVALUE)
  1.  ... S PARMS(NAME)=$G(PARMS(NAME))_"^"_ANAME_"="_AVALUE_"^"
  1.  . ; If no single value, check for multiple values
  1.  . I VALUE="" D
  1.  .. Q:'$D(^BQICARE(OWNR,1,PLIEN,10,N,1))
  1.  .. S NN=0 F  S NN=$O(^BQICARE(OWNR,1,PLIEN,10,N,1,NN)) Q:'NN  D
  1.  ... NEW AN,DA,IENS,VALUE
  1.  ... S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=N,DA=NN,IENS=$$IENS^DILF(.DA)
  1.  ... I PTYP="T" S VALUE=$$GET1^DIQ(90505.21,IENS,.02,"E")
  1.  ... I PTYP'="T" S VALUE=$$GET1^DIQ(90505.21,IENS,.01,"E")
  1.  ... I $O(^BQICARE(OWNR,1,PLIEN,10,N,1,NN,2,0))="" S MPARMS(NAME,VALUE)="" Q
  1.  ... S AN=0
  1.  ... F  S AN=$O(^BQICARE(OWNR,1,PLIEN,10,N,1,NN,2,AN)) Q:'AN  D
  1.  .... NEW DA,IENS,ANAME,AVALUE,APTYP
  1.  .... S DA(4)=OWNR,DA(3)=PLIEN,DA(2)=N,DA(1)=NN,DA=AN,IENS=$$IENS^DILF(.DA)
  1.  .... S ANAME=$$GET1^DIQ(90505.212,IENS,.01,"E")
  1.  .... S APTYP=$$PTYP^BQIDCDF(SOURCE,ANAME)
  1.  .... I APTYP="T" S AVALUE=$$GET1^DIQ(90505.212,IENS,.03,"E")
  1.  .... I APTYP'="T" S AVALUE=$$GET1^DIQ(90505.212,IENS,.02,"E")
  1.  .... I $E(AVALUE,1,2)="T-" S AVALUE=$$DATE^BQIUL1(AVALUE)
  1.  .... S MPARMS(NAME,VALUE)=$G(MPARMS(NAME,VALUE))_ANAME_"="_AVALUE_"^"
  1.  ;
  1.  I TYPE="Y" D  G EXIT:$G(BMXSEC)]""
  1.  . ; Check if 'My Patients Definition' exists
  1.  . I '$O(^BQICARE(OWNR,7,0)) S BMXSEC="MY PATIENTS DEFINITION was not found" Q
  1.  . NEW DA,IENS
  1.  . S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
  1.  . K DESC
  1.  . D DESC^BQIPDSCM(OWNR,PLIEN,.DESC)
  1.  . ;D PEN^BQIPLDSC(OWNR,PLIEN,.DESC)
  1.  . D WP^DIE(90505.01,IENS,5,"","DESC")
  1.  . K DESC
  1.  . S EXEC="D MYP^BQIPLPP"
  1.  ;
  1.  I TYPE="Q" D  G EXIT:$G(BMXSEC)'=""
  1.  . NEW FLAG,MTEXT
  1.  . S QMIEN=SOURCE
  1.  . I '$D(^DIBT(QMIEN)) D  Q
  1.  .. S BMXSEC="QMAN template was not found"
  1.  .. S FLAG="" I $G(ZTSK)'="" S FLAG=1
  1.  .. S MTEXT(1,0)="The QMAN template used in panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" appears"
  1.  .. S MTEXT(2,0)="to have been deleted from your server. You will be unable to manually or automatically populate this panel."
  1.  .. D ADD^BQINOTF("",OWNR,BMXSEC,.MTEXT,FLAG)
  1.  . S EXEC="D QM^BQIPLPP",GLREF=$NA(^TMP(UID,"BQIPQMAN"))
  1.  ;
  1.  I TYPE="P" D  G EXIT:$G(BMXSEC)'=""
  1.  . ; Find predefined panel and get parameters
  1.  . S PPIEN=$$PP^BQIDCDF(SOURCE) I PPIEN=-1 S BMXSEC="Pre-defined panel type "_SOURCE_" was not found" Q
  1.  . S EXEC=$$GET1^DIQ(90506,PPIEN_",",2,"E")
  1.  ;
  1.  S FGLOB=""
  1.  X EXEC
  1.  ;
  1.  K PARMS,MPARMS
  1.  ;
  1.  ; If filters exist
  1.  I $O(^BQICARE(OWNR,1,PLIEN,15,0))'="" D FLT G EXIT:$G(BMXSEC)]""
  1.  ;
  1.  ;  save the data returned after executable and filter applied
  1.  D SAVE(OWNR,PLIEN,GLREF,KEEP,$G(DCRIT))
  1.  ;
  1. DONE ;
  1.  K DA
  1.  S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
  1.  ;
  1.  S BQIUPD(90505.01,IENS,.07)=$$NOW^XLFDT()
  1.  S BQIUPD(90505.01,IENS,3.5)=$S($G(OVER):OVER,1:DUZ)
  1.  S BQIUPD(90505.01,IENS,3.9)=$$NOW^XLFDT()
  1.  D FILE^DIE("","BQIUPD")
  1.  ;
  1.  S CNT=$$GET1^DIQ(90505.01,IENS,.1,"E")
  1.  I CNT="" S CNT=0
  1.  S II=II+1,@DATA@(II)="I00010NUMBER_OF_PATIENTS"_$C(30)
  1.  S II=II+1,@DATA@(II)=CNT_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  1. EXIT ;
  1.  K AGE,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX
  1.  K DFN,DOB,SEX,SSN,X,Y,BQIUPD,GLREF,FGLOB
  1.  Q
  1.  ;
  1. SAVE(OWNR,PLIEN,GLREF,KEEP,DCRIT) ;EP - Save patient list
  1.  ;
  1.  ; First delete any patient before saving
  1.  S DFN=0
  1.  F  S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN  D
  1.  . NEW DA,IENS,STAT
  1.  . S DA(2)=OWNR,DA(1)=PLIEN,DA=DFN,IENS=$$IENS^DILF(.DA)
  1.  . I '$D(^DPT(DFN)) D DPT^BQIPLCR(DFN) Q
  1.  . ; if the patient was already 'added' or 'removed', quit unless KEEP is explicitly "N"
  1.  . S STAT=$$GET1^DIQ(90505.04,IENS,.02,"I")
  1.  . I STAT="A"!(STAT="R"),KEEP'="N" Q
  1.  . ; save off original patients
  1.  . S @TEMP@(DFN)=^BQICARE(OWNR,1,PLIEN,40,DFN,0)
  1.  . M @TEMP@(DFN,5)=^BQICARE(OWNR,1,PLIEN,40,DFN,5)
  1.  . ; otherwise, delete patient from panel
  1.  . D DPT^BQIPLCR(DFN)
  1.  ;
  1.  S DFN=""
  1.  F  S DFN=$O(@GLREF@(DFN)) Q:DFN=""  D
  1.  . I '$D(^DPT(DFN)) Q
  1.  . ; if patient already in panel check for FLAG value
  1.  . I $D(^BQICARE(OWNR,1,PLIEN,40,DFN)) D  Q
  1.  .. NEW DA,IENS,STAT
  1.  .. S DA(2)=OWNR,DA(1)=PLIEN,DA=DFN,IENS=$$IENS^DILF(.DA)
  1.  .. ; if the patient was already 'added' or 'removed', quit to preserve that value
  1.  .. S STAT=$$GET1^DIQ(90505.04,IENS,.02,"I")
  1.  .. I STAT="A"!(STAT="R") Q
  1.  . ; otherwise, add patient to panel
  1.  . D APT^BQIPLCR(DFN)
  1.  . I $D(@TEMP@(DFN)) S $P(^BQICARE(OWNR,1,PLIEN,40,DFN,0),U,7)=$P(@TEMP@(DFN),U,7)
  1.  ;
  1.  ; File any matched criteria
  1.  I $G(DCRIT)'="" D
  1.  . S CTYP=""
  1.  . F  S CTYP=$O(@DCRIT@(CTYP)) Q:CTYP=""  D
  1.  .. S DFN=""
  1.  .. F  S DFN=$O(@DCRIT@(CTYP,DFN)) Q:DFN=""  D APMTC^BQIPLCR(.DCRIT,.CTYP,.DFN)
  1.  ;
  1.  ;  Count the saved records
  1.  D CNTP^BQIPLCR(OWNR,PLIEN)
  1.  K @TEMP
  1.  Q
  1.  ;
  1. QM ;  Find DFNs in a QMAN search template
  1.  K @GLREF
  1.  NEW DFN,FILE,IEN
  1.  S FILE=$P($G(^DIBT(QMIEN,0)),U,4)
  1.  I FILE=9000001 D
  1.  . S DFN=0
  1.  . F  S DFN=$O(^DIBT(QMIEN,1,DFN)) Q:'DFN  S @GLREF@(DFN)=""
  1.  I FILE=9000010 D
  1.  . S IEN=0
  1.  . F  S IEN=$O(^DIBT(QMIEN,1,IEN)) Q:'IEN  D
  1.  .. I $P($G(^AUPNVSIT(IEN,0)),U,11)=1 Q
  1.  .. S DFN=$P($G(^AUPNVSIT(IEN,0)),U,5) Q:DFN=""
  1.  .. S @GLREF@(DFN)=""
  1.  Q
  1.  ;
  1. MYP ; Find DFNs using the MY PATIENTS DEFINITION
  1.  NEW MIEN,PIEN,PMIEN,DFN,MDATA
  1.  S MDATA=$NA(^TMP(UID,"BQIPMYP"))
  1.  K @MDATA
  1.  S MIEN=0
  1.  F  S MIEN=$O(^BQICARE(OWNR,7,MIEN)) Q:'MIEN  D
  1.  . NEW DA,IENS
  1.  . S DA(1)=OWNR,DA=MIEN,IENS=$$IENS^DILF(.DA)
  1.  . S SOURCE=$$GET1^DIQ(90505.07,IENS,.01,"E")
  1.  . S PPIEN=$$PP^BQIDCDF(SOURCE) I PPIEN=-1 Q
  1.  . S EXEC=$$GET1^DIQ(90506,PPIEN_",",2,"E")
  1.  . K PARMS,MPARMS
  1.  . S PIEN=0
  1.  . F  S PIEN=$O(^BQICARE(OWNR,7,MIEN,10,PIEN)) Q:'PIEN  D
  1.  .. NEW DA,IENS,NAME,VALUE
  1.  .. S DA(2)=OWNR,DA(1)=MIEN,DA=PIEN,IENS=$$IENS^DILF(.DA)
  1.  .. S NAME=$$GET1^DIQ(90505.08,IENS,.01,"E")
  1.  .. S PTYP=$$PTYP^BQIDCDF(SOURCE,NAME)
  1.  .. I PTYP="T" S VALUE=$$GET1^DIQ(90505.08,IENS,.03,"E")
  1.  .. I PTYP'="T" S VALUE=$$GET1^DIQ(90505.08,IENS,.02,"E")
  1.  .. I $E(VALUE,1,2)="T-" S VALUE=$$DATE^BQIUL1(VALUE)
  1.  .. I VALUE'="" S PARMS(NAME)=VALUE Q
  1.  .. I VALUE="" D
  1.  ... Q:'$D(^BQICARE(OWNR,7,MIEN,10,PIEN,1))
  1.  ... S PMIEN=0 F  S PMIEN=$O(^BQICARE(OWNR,7,MIEN,10,PIEN,1,PMIEN)) Q:'PMIEN  D
  1.  .... NEW DA,IENS,VALUE
  1.  .... S DA(3)=OWNR,DA(2)=MIEN,DA(1)=PIEN,DA=PMIEN,IENS=$$IENS^DILF(.DA)
  1.  .... I PTYP="T" S VALUE=$$GET1^DIQ(90505.81,IENS,.02,"E")
  1.  .... I PTYP'="T" S VALUE=$$GET1^DIQ(90505.81,IENS,.01,"E")
  1.  .... S MPARMS(NAME,VALUE)=""
  1.  . X EXEC
  1.  . S DFN=0 F  S DFN=$O(@GLREF@(DFN)) Q:'DFN  S @MDATA@(DFN)=""
  1.  S GLREF=$NA(^TMP(UID,"BQIPMYP"))
  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.  D STA^BQIPLRF(OWNR,PLIEN)
  1.  Q
  1.  ;
  1. FLT ; Get filter parameters
  1.  S PPIEN=$$PP^BQIDCDF(FSOURCE) I PPIEN=-1 S BMXSEC="Pre-defined filter type "_FSOURCE_" was not found" Q
  1.  S FEXEC=$$GET1^DIQ(90506,PPIEN_",",2,"E")
  1.  S N=0
  1.  F  S N=$O(^BQICARE(OWNR,1,PLIEN,15,N)) Q:'N  D
  1.  . NEW DA,IENS,NAME,VALUE
  1.  . S DA(2)=OWNR,DA(1)=PLIEN,DA=N,IENS=$$IENS^DILF(.DA)
  1.  . S NAME=$$GET1^DIQ(90505.115,IENS,.01,"E")
  1.  . S PTYP=$$PTYP^BQIDCDF(FSOURCE,NAME)
  1.  . I PTYP="T" S VALUE=$$GET1^DIQ(90505.115,IENS,.03,"E")
  1.  . I PTYP'="T" S VALUE=$$GET1^DIQ(90505.115,IENS,.02,"E")
  1.  . I $E(VALUE,1,2)="T-" S VALUE=$$DATE^BQIUL1(VALUE)
  1.  . I VALUE'="" S PARMS(NAME)=VALUE D CKAS Q
  1.  . I VALUE="" D
  1.  .. Q:'$D(^BQICARE(OWNR,1,PLIEN,15,N,1))
  1.  .. S NN=0 F  S NN=$O(^BQICARE(OWNR,1,PLIEN,15,N,1,NN)) Q:'NN  D
  1.  ... NEW DA,IENS,VALUE
  1.  ... S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=N,DA=NN,IENS=$$IENS^DILF(.DA)
  1.  ... I PTYP="T" S VALUE=$$GET1^DIQ(90505.1151,IENS,.02,"E")
  1.  ... I PTYP'="T" S VALUE=$$GET1^DIQ(90505.1151,IENS,.01,"E")
  1.  ... I $E(VALUE,1,2)="T-" S VALUE=$$DATE^BQIUL1(VALUE)
  1.  ... S MPARMS(NAME,VALUE)="" I NAME="NUMVIS" S MAPARMS(NN,NAME)=VALUE
  1.  ... S ASN=0
  1.  ... F  S ASN=$O(^BQICARE(OWNR,1,PLIEN,15,N,1,NN,2,ASN)) Q:'ASN  D
  1.  .... NEW DA,IENS
  1.  .... S DA(4)=OWNR,DA(3)=PLIEN,DA(2)=N,DA(1)=NN,DA=ASN,IENS=$$IENS^DILF(.DA)
  1.  .... S ASSOC=$$GET1^DIQ(90505.11512,IENS,.01,"E")
  1.  .... S ATYP=$$PTYP^BQIDCDF(FSOURCE,ASSOC)
  1.  .... I ATYP="T" S AVALUE=$$GET1^DIQ(90505.11512,IENS,.03,"E")
  1.  .... I ATYP'="T" S AVALUE=$$GET1^DIQ(90505.11512,IENS,.02,"E")
  1.  .... I $E(AVALUE,1,2)="T-" S AVALUE=$$DATE^BQIUL1(AVALUE)
  1.  .... I AVALUE'="" D
  1.  ..... I NAME'="NUMVIS" S APARMS(NAME,VALUE,ASSOC)=AVALUE Q
  1.  ..... S APARMS(NAME,VALUE,ASSOC,AVALUE)="",MAPARMS(NN,ASSOC)=AVALUE,MAPARMS(NN,NAME)=VALUE
  1.  .... I AVALUE="" D
  1.  ..... Q:'$D(^BQICARE(OWNR,1,PLIEN,15,N,1,NN,2,ASN,1))
  1.  ..... S ANN=0 F  S ANN=$O(^BQICARE(OWNR,1,PLIEN,15,N,1,NN,2,ASN,1,ANN)) Q:'ANN  D
  1.  ...... NEW DA,IENS
  1.  ...... S DA(5)=OWNR,DA(4)=PLIEN,DA(3)=N,DA(2)=NN,DA(1)=ASN,DA=ANN,IENS=$$IENS^DILF(.DA)
  1.  ...... I ATYP="T" S AVALUE=$$GET1^DIQ(90505.115121,IENS,.02,"E")
  1.  ...... I ATYP'="T" S AVALUE=$$GET1^DIQ(90505.115121,IENS,.01,"E")
  1.  ...... I $E(AVALUE,1,2)="T-" S AVALUE=$$DATE^BQIUL1(AVALUE)
  1.  ...... S MAPARMS(NAME,VALUE,ASSOC,AVALUE)=""
  1.  ; set FGLOB equal to the global that was populated by executable
  1.  S FGLOB=$G(GLREF)
  1.  ; call filter code
  1.  X FEXEC
  1.  Q
  1.  ;
  1. CKAS ; Check for associated parameters
  1.  S ASN=0
  1.  F  S ASN=$O(^BQICARE(OWNR,1,PLIEN,15,N,2,ASN)) Q:'ASN  D
  1.  . NEW DA,IENS
  1.  . S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=N,DA=ASN,IENS=$$IENS^DILF(.DA)
  1.  . S ASSOC=$$GET1^DIQ(90505.1152,IENS,.01,"E")
  1.  . S ATYP=$$PTYP^BQIDCDF(FSOURCE,ASSOC)
  1.  . I ATYP="T" S AVALUE=$$GET1^DIQ(90505.1152,IENS,.03,"E")
  1.  . I ATYP'="T" S AVALUE=$$GET1^DIQ(90505.1152,IENS,.02,"E")
  1.  . I $E(AVALUE,1,2)="T-" S AVALUE=$$DATE^BQIUL1(AVALUE)
  1.  . I AVALUE'="" D
  1.  .. I NAME'="NUMVIS" S APARMS(NAME,VALUE,ASSOC)=AVALUE Q
  1.  .. S APARMS(NAME,VALUE,ASSOC)=AVALUE,MAPARMS(N,ASSOC)=AVALUE,MAPARMS(N,NAME)=VALUE
  1.  . I AVALUE="" D
  1.  .. I NAME="NUMVIS" S MAPARMS(N,NAME)=VALUE
  1.  .. Q:'$D(^BQICARE(OWNR,1,PLIEN,15,N,2,ASN,1))
  1.  .. S ANN=0 F  S ANN=$O(^BQICARE(OWNR,1,PLIEN,15,N,2,ASN,1,ANN)) Q:'ANN  D
  1.  ... NEW DA,IENS,AVALUE
  1.  ... S DA(4)=OWNR,DA(3)=PLIEN,DA(2)=N,DA(1)=ASN,DA=ANN,IENS=$$IENS^DILF(.DA)
  1.  ... I ATYP="T" S AVALUE=$$GET1^DIQ(90505.11521,IENS,.02,"E")
  1.  ... I ATYP'="T" S AVALUE=$$GET1^DIQ(90505.11521,IENS,.01,"E")
  1.  ... I $E(AVALUE,1,2)="T-" S AVALUE=$$DATE^BQIUL1(AVALUE)
  1.  ... S MAPARMS(NAME,VALUE,ASSOC,AVALUE)=""
  1.  Q