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

BPSUSCR2.m

Go to the documentation of this file. 
  1. BPSUSCR2 ;ALB ISC/SS - STRANDED SUBMISSIONS SCREEN (cont) ;02-MAY-2008
  1.  ;;1.0;E CLAIMS MGMT ENGINE;**7,10,11**;JUN 2004;Build 27
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1.  ;Stranded requests with BPS TRANSACTION record
  1.  ;   Input:
  1.  ;     BPARR - Date Range
  1.  ;   Output:
  1.  ;     ^TMP("BPSUSCR",$J)
  1.  ;     ^TMP($J,2)
  1. COLACTRQ(BPARR) ;
  1.  N KEY1,KEY2,BPIEN77,BPRX,FILL,COB
  1.  N TFILE,CFILE,STATUS,IEN59,VART,LSTUDT,CD0
  1.  N NAME,SSN,INSCO,DOS,BPTYPE
  1.  N BPBDT,BPEDT
  1.  S TFILE=9002313.59,CFILE=9002313.02
  1.  S BPBDT=BPARR("BDT") ;start date and time
  1.  S BPEDT=BPARR("EDT") ;end date and time
  1.  S KEY1=0
  1.  F  S KEY1=$O(^BPS(9002313.77,"AC",2,KEY1)) Q:+KEY1=0  D
  1.  .S KEY2=""
  1.  .F  S KEY2=$O(^BPS(9002313.77,"AC",2,KEY1,KEY2)) Q:KEY2=""  D
  1.  .. S BPIEN77=+$O(^BPS(9002313.77,"AC",2,KEY1,KEY2,0))
  1.  .. S COB=$$GET1^DIQ(9002313.77,BPIEN77,.03,"I")
  1.  .. S IEN59=$$IEN59^BPSOSRX(KEY1,KEY2,COB)
  1.  .. S VART=$G(^BPST(IEN59,0))
  1.  .. ; If the transaction is missing, get the data from the request
  1.  .. I VART="" D REQSTTMP Q
  1.  .. ; If the Request pointer in the transaction is not the same as the
  1.  .. ;   original request from the request file, get the data from the request
  1.  .. S BPTYPE=$P(VART,"^",15)
  1.  .. I BPIEN77'=0,BPIEN77'=+$$GETRQST^BPSUTIL2(IEN59) D REQSTTMP Q
  1.  .. S LSTUDT=$$GET1^DIQ(TFILE,IEN59,7,"I")
  1.  .. I LSTUDT<BPBDT!(LSTUDT>BPEDT) Q
  1.  .. S LSTUDT=$P(LSTUDT,".",1)
  1.  .. I LSTUDT="" Q
  1.  .. S BPTYPE=$P(VART,"^",15)
  1.  .. S BPTYPE=$S(BPTYPE="C":1,BPTYPE="U":2,BPTYPE="E":3,1:4)
  1.  .. I $D(^TMP("BPSUSCR-1",$J,BPTYPE,LSTUDT,+IEN59)) Q  ;already has it
  1.  .. S BPRX=$$GET1^DIQ(TFILE,IEN59,1.11,"E")
  1.  .. S FILL=$$GET1^DIQ(TFILE,IEN59,9)
  1.  .. S STATUS=$P(VART,"^",2)
  1.  .. S CD0=$$GET1^DIQ(TFILE,IEN59,3,"I")
  1.  .. I CD0'="" D
  1.  ... S DOS=$$HL7TFM^XLFDT($$GET1^DIQ(CFILE,CD0,401))
  1.  .. I CD0="" D
  1.  ... S DOS=$P($G(^BPST(IEN59,12)),"^",2)
  1.  .. S NAME=$$GET1^DIQ(TFILE,IEN59,5,"E")
  1.  .. S SSN=""
  1.  .. I $P(VART,"^",6)]"" S SSN=$P($G(^DPT($P(VART,"^",6),0)),"^",9),SSN=$E(SSN,$L(SSN)-3,$L(SSN))
  1.  .. S INSCO=$P($G(^BPST(IEN59,10,1,0)),"^",7)
  1.  .. S ^TMP("BPSUSCR-1",$J,BPTYPE,LSTUDT,IEN59)=NAME_U_SSN_U_BPRX_U_FILL_U_DOS_U_INSCO_U_STATUS
  1.  Q
  1.  ;
  1.  ;Stranded requests without BPS TRANSACTION record
  1.  ;Note the IEN59 here is a calculated ien only - the record doesn't exist
  1. REQSTTMP ;
  1.  N BPDFN,BPIEN78,BPX
  1.  I BPIEN77=0 Q
  1.  S STATUS=-96
  1.  S LSTUDT=$$GET1^DIQ(9002313.77,BPIEN77,6.05,"I")
  1.  I LSTUDT<BPBDT!(LSTUDT>BPEDT) Q
  1.  S LSTUDT=$P(LSTUDT,".",1)
  1.  I LSTUDT="" Q
  1.  S BPTYPE=$$GET1^DIQ(9002313.77,BPIEN77,1.04,"I")
  1.  S BPTYPE=$S(BPTYPE="C":1,BPTYPE="U":2,BPTYPE="E":3,1:4)
  1.  I $D(^TMP("BPSUSCR-1",$J,BPTYPE,LSTUDT,+IEN59)) Q  ;already has it
  1.  S BPRX=$$GET1^DIQ(9002313.77,BPIEN77,1.13,"E")
  1.  S FILL=$$GET1^DIQ(9002313.77,BPIEN77,1.14)
  1.  S DOS=$$GET1^DIQ(9002313.77,BPIEN77,2.01,"I")
  1.  S NAME=$$GET1^DIQ(9002313.77,BPIEN77,1.15,"E")
  1.  S BPDFN=$$GET1^DIQ(9002313.77,BPIEN77,1.15,"I")
  1.  ; Older request might not have the Patient Name so get it from
  1.  ;   the RX
  1.  I BPDFN="",BPRX D
  1.  . S NAME=$$RXAPI1^BPSUTIL1(BPRX,2,"E")
  1.  . S BPDFN=$$RXAPI1^BPSUTIL1(BPRX,2,"I")
  1.  S SSN=""
  1.  I BPDFN>0 S SSN=$P($G(^DPT(BPDFN,0)),"^",9),SSN=$E(SSN,$L(SSN)-3,$L(SSN))
  1.  S BPX=$O(^BPS(9002313.77,BPIEN77,5,0))
  1.  I BPX>0 S BPIEN78=+$P($G(^BPS(9002313.77,BPIEN77,5,BPX,0)),U,3),INSCO=$$GET1^DIQ(9002313.78,BPIEN78,.07,"E")
  1.  E  S INSCO="UNKNOWN"
  1.  S ^TMP("BPSUSCR-1",$J,BPTYPE,LSTUDT,IEN59)=NAME_U_SSN_U_BPRX_U_FILL_U_DOS_U_INSCO_U_STATUS_U_BPIEN77
  1.  Q