IBATLM1A ;LL/ELZ - TRANSFER PRICING BUILD TRAN LIST ; 10-SEP-1998
 ;;2.0;INTEGRATED BILLING;**115**;21-MAR-94
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
ARRAY(IBARRAY) ; -- builds lm array for transaction list
 N IBSTRNG,IBDAT,IBNODE K ^TMP("VALM DATA",$J),^TMP("VALMAR",$J)
 S VALMCNT=0
 D PTTRAN^IBATUTL(351.61,"^TMP(""IBAT"",$J)","AH")
 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
 . F IBNODE=0,6 S IBDAT(IBNODE)=^TMP("IBAT",$J,IBDAT,IBIEN,IBNODE)
 . S IBSTRNG=""
 . S IBSTRNG=$$ST(VALMCNT+1,IBSTRNG,"LIST#")
 . S IBSTRNG=$$ST($$DAT1^IBOUTL($P(IBDAT(0),"^",9)),IBSTRNG,"FDATE")
 . S IBSTRNG=$$ST($$DAT1^IBOUTL($P(IBDAT(0),"^",10)),IBSTRNG,"TDATE")
 . S IBSTRNG=$$ST($$EX^IBATUTL(351.61,.05,$P(IBDAT(0),"^",5)),IBSTRNG,"STATUS")
 . 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")
 . S IBSTRNG=$$ST($$EX^IBATUTL(351.61,.11,$P(IBDAT(0),"^",11)),IBSTRNG,"FACILITY")
 . S IBSTRNG=$$ST("$"_$P(IBDAT(6),"^",2),IBSTRNG,"AMOUNT")
 . S VALMCNT=$$SETVALM^IBATUTL(VALMCNT,IBSTRNG,IBIEN)
 I 'VALMCNT D SET^VALM10(1," "),SET^VALM10(2,"No transactions meet criteria") S VALMCNT=2
 K ^TMP("IBAT",$J)
 Q
ST(A,B,C) ; -- calls VALM1 to set string up
 ;
 Q $$SETFLD^VALM1($$LOWER^VALM1(A),B,C)