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

BLRALDR.m

Go to the documentation of this file. 
  1. BLRALDR ;DAOU/ALA-Lab Review Delinquent Report 
  1.  ;;5.2T9;LR;**1013,1015,1018**;Nov 17, 2004
  1.  ;;5.2;LR;**1013,1015**;Nov 18, 2002
  1.  ;
  1.  ;**Program Description**
  1.  ;  This routine builds a ListMan screen of all delinquent lab
  1.  ;  results based upon a supervisor's subordinates and the
  1.  ;  supervisor's normal and abnormal review days defined
  1.  ;
  1. CSUP ;  Check for all subordinates of a Clinician Supervisor
  1.  K ^TMP("BLRADELQ",$J)
  1.  ;
  1.  ;  Get the Normal and Abnormal review days
  1.  S BLRANRN=$$GET1^DIQ(9009027.1,DUZ,.04,"E")
  1.  S BLRAARN=$$GET1^DIQ(9009027.1,DUZ,.05,"E")
  1.  S BLRACRN=$$GET1^DIQ(9009027.1,DUZ,.06,"E")
  1.  ;
  1.  S BLRADUZ=""
  1.  F  S BLRADUZ=$O(^BLRALAB(9009027.1,"C",DUZ,BLRADUZ)) Q:BLRADUZ=""  D FND
  1.  ;
  1.  D EN^BLRAL3
  1.  ;
  1.  K BLRA0,BLRAAB,BLRAARN,BLRACCN,BLRADATA,BLRADLT,BLRADTT,BLRADUZ,BLRADT
  1.  K BLRANRN,BLRAOPH,BLRAP,BLRAPD,BLRAPFL,BLRAPIEN,BLRAPNM,BLRAS,BLRACRT
  1.  K BLRASTAT,BLRIDT,BLRSS,BLRVD,^TMP("BLRADELQ",$J),BLRACRN,BLRADAYS
  1.  K BLRALINE,BLRALVAR,BLRAOPNM,BLRAPHY,BLRARPHY,BLRARPNM,BLRASTA,BLRAVD
  1.  K BLRAVT,DATE
  1.  Q
  1.  ;
  1. FND ;  Find results
  1.  S BLRAS=""
  1.  F  S BLRAS=$O(^LR("BLRA",BLRADUZ,BLRAS)) Q:BLRAS=2!(BLRAS="")  D
  1.  . S BLRVD=""
  1.  . F  S BLRVD=$O(^LR("BLRA",BLRADUZ,BLRAS,BLRVD)) Q:BLRVD=""  D
  1.  .. S BLRAP=""
  1.  .. F  S BLRAP=$O(^LR("BLRA",BLRADUZ,BLRAS,BLRVD,BLRAP)) Q:BLRAP=""  D
  1.  ... ;S BLRIDT=$P(BLRVD,"-",2),BLRSS=$G(^LR("BLRA",BLRADUZ,BLRAS,BLRVD,BLRAP))
  1.  ... ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
  1.  ... ;ADDED BLRSS AS SUBSCRIPT
  1.  ... S BLRSS=""
  1.  ... F  S BLRSS=$O(^LR("BLRA",BLRADUZ,BLRAS,BLRVD,BLRAP,BLRSS)) Q:BLRSS=""  D
  1.  .... S BLRIDT=$P(BLRVD,"-",2)
  1.  .... ;----- END IHS MODIFICATIONS
  1.  .... S BLRA0=$G(^LR(BLRAP,BLRSS,BLRIDT,0))
  1.  .... S BLRADATA=$G(^LR(BLRAP,BLRSS,BLRIDT,9009027))
  1.  .... Q:$G(BLRADATA)=""  ;IF NOT THERE ITS BEEN DELETED
  1.  .... ;
  1.  .... S BLRAAB=$P(BLRADATA,U,6),BLRAPD=$P(BLRADATA,U,7),BLRACRT=+$P(BLRADATA,U,8)
  1.  .... ;
  1.  .... ;  If any pending results, don't put on the delinquent report
  1.  .... I BLRAPD Q
  1.  .... S BLRARPHY=$P(BLRADATA,U,2)
  1.  .... S BLRARPNM=$P($G(^VA(200,BLRARPHY,0)),U)
  1.  .... ;
  1.  .... S BLRADTT=$P(BLRA0,U,1),BLRAOPH=$P(BLRA0,U,$S(BLRSS="MI":7,1:10))
  1.  .... S BLRACCN=$P(BLRA0,U,6),BLRAOPNM=$P($G(^VA(200,BLRAOPH,0)),U)
  1.  .... S BLRAPFL=$P($G(^LR(BLRAP,0)),U,2),BLRAPIEN=$P($G(^(0)),U,3)
  1.  .... S BLRAPNM=$$GET1^DIQ(BLRAPFL,BLRAPIEN,.01,"E")
  1.  .... ;
  1.  .... S BLRASTAT=$S(BLRACRT'=0:"CRIT",BLRAAB'=0:"ABN",1:"NOR")
  1.  .... S BLRASTA=$S(BLRASTAT="CRIT":"AAC",1:BLRASTAT)
  1.  .... ;
  1.  .... S BLRADLT=$$FMADD^XLFDT(BLRADTT\1,$S(BLRASTAT="ABN":BLRAARN,BLRASTAT="CRIT":BLRACRN,1:BLRANRN))
  1.  .... I DT'>BLRADLT Q
  1.  .... ;
  1.  .... S BLRADAYS=$$FMDIFF^XLFDT(DT,BLRADLT,1)
  1.  .... ;
  1.  .... S BLRAVT=$P(BLRADTT,".",2),BLRAVT=BLRAVT_$E("000000",$L(BLRAVT),7)
  1.  .... S BLRAVD=$P(BLRADTT,".",1)_"."_BLRAVT
  1.  .... ;S ^TMP("BLRADELQ",$J,BLRARPNM,BLRASTA,BLRAVD,BLRAP)=BLRACCN_U_BLRAPNM_U_(BLRADTT\1)_U_BLRAOPNM_U_BLRASTAT_U_BLRADAYS
  1.  .... ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
  1.  .... S ^TMP("BLRADELQ",$J,BLRARPNM,BLRASTA,BLRAVD,BLRAP,BLRSS)=BLRACCN_U_BLRAPNM_U_(BLRADTT\1)_U_BLRAOPNM_U_BLRASTAT_U_BLRADAYS
  1.  .... ;----- END IHS MODIFICATIONS
  1.  .... ;S ^TMP("BLRADELQ",$J,BLRARPNM,BLRASTA,BLRAVD,BLRAP,"ZNODE")=BLRAP_U_BLRSS_U_BLRIDT
  1.  Q