| 1 | BPSUSCR4 ;BHAM ISC/FLS - USER SCREEN ;14-FEB-05
 | 
|---|
| 2 |  ;;1.0;E CLAIMS MGMT ENGINE;**1,3**;JUN 2004;Build 20
 | 
|---|
| 3 |  ;; Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 |  Q
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 |  ; COLLECT - Compile stranded claims
 | 
|---|
| 8 |  ;   Input:
 | 
|---|
| 9 |  ;     BPARR - Date Range
 | 
|---|
| 10 |  ;   Output:
 | 
|---|
| 11 |  ;     ^TMP("BPSUSCR",$J)
 | 
|---|
| 12 |  ;     ^TMP($J,2)
 | 
|---|
| 13 | COLLECT(BPARR) ;
 | 
|---|
| 14 |  N TFILE,CFILE,SDT,STATUS,IEN59,VART,LSTUDT,CD0,DATA
 | 
|---|
| 15 |  N RX,REFILL,NAME,SSN,INSCO,FILLDT,SEQ,ITEM,MESSAGE
 | 
|---|
| 16 |  K BPBDT,BPEDT
 | 
|---|
| 17 |  K ^TMP($J),^TMP("BPSUSCR",$J)
 | 
|---|
| 18 |  S VALMCNT=0,TFILE=9002313.59,CFILE=9002313.02
 | 
|---|
| 19 |  S BPBDT=BPARR("BDT") ;start date and time
 | 
|---|
| 20 |  S BPEDT=BPARR("EDT") ;end date and time
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 |  ; Loop through all statii from 0 to 98
 | 
|---|
| 23 |  S STATUS=-1
 | 
|---|
| 24 |  F  S STATUS=$O(^BPST("AD",STATUS)) Q:STATUS>98!(STATUS="")  D
 | 
|---|
| 25 |  . ; Status of 31 is Insurer Asleep - these will process when insurer wakes up
 | 
|---|
| 26 |  . ; Insurer asleep disabled for Phase III so these should appear on the report for now
 | 
|---|
| 27 |  . ;I STATUS=31 Q
 | 
|---|
| 28 |  . S IEN59=0
 | 
|---|
| 29 |  . F  S IEN59=$O(^BPST("AD",STATUS,IEN59)) Q:'IEN59  D
 | 
|---|
| 30 |  .. S VART=$G(^BPST(IEN59,0)) Q:VART=""
 | 
|---|
| 31 |  .. S LSTUDT=$$GET1^DIQ(TFILE,IEN59,7,"I")
 | 
|---|
| 32 |  .. I LSTUDT<BPBDT!(LSTUDT>BPEDT) Q
 | 
|---|
| 33 |  .. S LSTUDT=$P(LSTUDT,".",1)
 | 
|---|
| 34 |  .. I LSTUDT="" Q
 | 
|---|
| 35 |  .. S RX=$$GET1^DIQ(TFILE,IEN59,1.11)
 | 
|---|
| 36 |  .. S REFILL=$$GET1^DIQ(TFILE,IEN59,9)
 | 
|---|
| 37 |  .. S CD0=$$GET1^DIQ(TFILE,IEN59,3,"I")
 | 
|---|
| 38 |  .. I CD0'="" D
 | 
|---|
| 39 |  ... S FILLDT=$$GET1^DIQ(CFILE,CD0,401),FILLDT=$$HL7TFM^XLFDT(FILLDT)
 | 
|---|
| 40 |  .. I CD0="" D
 | 
|---|
| 41 |  ... S FILLDT=$P($G(^BPST(IEN59,12)),"^",2)
 | 
|---|
| 42 |  .. S NAME=$$GET1^DIQ(TFILE,IEN59,5,"E")
 | 
|---|
| 43 |  .. S SSN="",VART=$G(^BPST(IEN59,0))
 | 
|---|
| 44 |  .. I $P(VART,"^",6)]"" S SSN=$P($G(^DPT($P(VART,"^",6),0)),"^",9),SSN=$E(SSN,$L(SSN)-3,$L(SSN))
 | 
|---|
| 45 |  .. S INSCO=$P($G(^BPST(IEN59,10,1,0)),"^",7)
 | 
|---|
| 46 |  .. S ^TMP($J,1,LSTUDT,IEN59)=NAME_U_SSN_U_RX_U_REFILL_U_FILLDT_U_INSCO_U_STATUS
 | 
|---|
| 47 |  ;
 | 
|---|
| 48 |  ; Now that the data is sorted, format it and build list for display
 | 
|---|
| 49 |  S (SEQ,ITEM)=0
 | 
|---|
| 50 |  S SDT="" F  S SDT=$O(^TMP($J,1,SDT)) Q:SDT=""  D
 | 
|---|
| 51 |  . S IEN59="" F  S IEN59=$O(^TMP($J,1,SDT,IEN59)) Q:IEN59=""  D
 | 
|---|
| 52 |  .. S DATA=$G(^TMP($J,1,SDT,IEN59))
 | 
|---|
| 53 |  .. S LSTUDT=$$FORMAT($$FMTE^XLFDT(SDT,"5Z"),10)
 | 
|---|
| 54 |  .. S NAME=$$FORMAT($P(DATA,U,1),20)
 | 
|---|
| 55 |  .. S SSN=$$FORMAT($P(DATA,U,2),4)
 | 
|---|
| 56 |  .. S RX=$$FORMAT($P(DATA,U,3),12)
 | 
|---|
| 57 |  .. S REFILL=$J($P(DATA,U,4),2)
 | 
|---|
| 58 |  .. S FILLDT=$$FMTE^XLFDT($P(DATA,U,5),"5Z")
 | 
|---|
| 59 |  .. S INSCO=$$FORMAT($P(DATA,U,6),12)
 | 
|---|
| 60 |  .. S SEQ=SEQ+1
 | 
|---|
| 61 |  .. S ITEM=ITEM+1
 | 
|---|
| 62 |  .. S ^TMP("BPSUSCR",$J,SEQ,0)=$J(ITEM,3)_" "_LSTUDT_" "_NAME_" "_SSN_" "_RX_" "_REFILL_" "_FILLDT_" "_INSCO
 | 
|---|
| 63 |  .. S ^TMP($J,2,ITEM,IEN59)=""
 | 
|---|
| 64 |  .. S SEQ=SEQ+1
 | 
|---|
| 65 |  .. S MESSAGE=$$STATI^BPSOSU($P(DATA,U,7))
 | 
|---|
| 66 |  .. I $E(MESSAGE,1)="?" S MESSAGE="Unknown Status"
 | 
|---|
| 67 |  .. S ^TMP("BPSUSCR",$J,SEQ,0)="    In Progress - "_MESSAGE
 | 
|---|
| 68 |  S VALMCNT=SEQ
 | 
|---|
| 69 |  Q
 | 
|---|
| 70 |  ;
 | 
|---|
| 71 | FORMAT(D1,LEN) ;
 | 
|---|
| 72 |  N OUT
 | 
|---|
| 73 |  S D1=$G(D1),LEN=$G(LEN)
 | 
|---|
| 74 |  S D1=$$NOSPACE(D1)
 | 
|---|
| 75 |  S OUT=$E($E(D1,1,LEN)_$J("",LEN),1,LEN)
 | 
|---|
| 76 |  Q OUT
 | 
|---|
| 77 | NOSPACE(VAR) ;
 | 
|---|
| 78 |  N RTN,SEQ,I
 | 
|---|
| 79 |  S RTN=""
 | 
|---|
| 80 |  F I=1:1:$L(VAR," ") I $P(VAR," ",I)'="" S SEQ=$G(SEQ)+1,$P(RTN," ",SEQ)=$P(VAR," ",I)
 | 
|---|
| 81 |  Q RTN
 | 
|---|