| [613] | 1 | IBATLM1A ;LL/ELZ - TRANSFER PRICING BUILD TRAN LIST ; 10-SEP-1998
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**115**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ARRAY(IBARRAY) ; -- builds lm array for transaction list
|
|---|
| 6 | N IBSTRNG,IBDAT,IBNODE K ^TMP("VALM DATA",$J),^TMP("VALMAR",$J)
|
|---|
| 7 | S VALMCNT=0
|
|---|
| 8 | D PTTRAN^IBATUTL(351.61,"^TMP(""IBAT"",$J)","AH")
|
|---|
| 9 | S IBDAT=9999999 F S IBDAT=$O(^TMP("IBAT",$J,IBDAT),-1) Q:IBDAT<1 S IBIEN=0 F S IBIEN=$O(^TMP("IBAT",$J,IBDAT,IBIEN)) Q:IBIEN<1 D
|
|---|
| 10 | . F IBNODE=0,6 S IBDAT(IBNODE)=^TMP("IBAT",$J,IBDAT,IBIEN,IBNODE)
|
|---|
| 11 | . S IBSTRNG=""
|
|---|
| 12 | . S IBSTRNG=$$ST(VALMCNT+1,IBSTRNG,"LIST#")
|
|---|
| 13 | . S IBSTRNG=$$ST($$DAT1^IBOUTL($P(IBDAT(0),"^",9)),IBSTRNG,"FDATE")
|
|---|
| 14 | . S IBSTRNG=$$ST($$DAT1^IBOUTL($P(IBDAT(0),"^",10)),IBSTRNG,"TDATE")
|
|---|
| 15 | . S IBSTRNG=$$ST($$EX^IBATUTL(351.61,.05,$P(IBDAT(0),"^",5)),IBSTRNG,"STATUS")
|
|---|
| 16 | . S IBSTRNG=$$ST($S($P(IBDAT(0),"^",12)["DGPM":"Inpatient",$P(IBDAT(0),"^",12)["SCE":"Outpatient",$P(IBDAT(0),"^",12)["RMPR":"Prosthetic",1:"Pharmacy"),IBSTRNG,"TYPE")
|
|---|
| 17 | . S IBSTRNG=$$ST($$EX^IBATUTL(351.61,.11,$P(IBDAT(0),"^",11)),IBSTRNG,"FACILITY")
|
|---|
| 18 | . S IBSTRNG=$$ST("$"_$P(IBDAT(6),"^",2),IBSTRNG,"AMOUNT")
|
|---|
| 19 | . S VALMCNT=$$SETVALM^IBATUTL(VALMCNT,IBSTRNG,IBIEN)
|
|---|
| 20 | I 'VALMCNT D SET^VALM10(1," "),SET^VALM10(2,"No transactions meet criteria") S VALMCNT=2
|
|---|
| 21 | K ^TMP("IBAT",$J)
|
|---|
| 22 | Q
|
|---|
| 23 | ST(A,B,C) ; -- calls VALM1 to set string up
|
|---|
| 24 | ;
|
|---|
| 25 | Q $$SETFLD^VALM1($$LOWER^VALM1(A),B,C)
|
|---|
