| [613] | 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 | 
|---|