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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBATLM1A 1438 printed Dec 13, 2024@02:07:51 Page 2
IBATLM1A ;LL/ELZ - TRANSFER PRICING BUILD TRAN LIST ; 10-SEP-1998
+1 ;;2.0;INTEGRATED BILLING;**115**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
ARRAY(IBARRAY) ; -- builds lm array for transaction list
+1 NEW IBSTRNG,IBDAT,IBNODE
KILL ^TMP("VALM DATA",$JOB),^TMP("VALMAR",$JOB)
+2 SET VALMCNT=0
+3 DO PTTRAN^IBATUTL(351.61,"^TMP(""IBAT"",$J)","AH")
+4 SET IBDAT=9999999
FOR
SET IBDAT=$ORDER(^TMP("IBAT",$JOB,IBDAT),-1)
if IBDAT<1
QUIT
SET IBIEN=0
FOR
SET IBIEN=$ORDER(^TMP("IBAT",$JOB,IBDAT,IBIEN))
if IBIEN<1
QUIT
Begin DoDot:1
+5 FOR IBNODE=0,6
SET IBDAT(IBNODE)=^TMP("IBAT",$JOB,IBDAT,IBIEN,IBNODE)
+6 SET IBSTRNG=""
+7 SET IBSTRNG=$$ST(VALMCNT+1,IBSTRNG,"LIST#")
+8 SET IBSTRNG=$$ST($$DAT1^IBOUTL($PIECE(IBDAT(0),"^",9)),IBSTRNG,"FDATE")
+9 SET IBSTRNG=$$ST($$DAT1^IBOUTL($PIECE(IBDAT(0),"^",10)),IBSTRNG,"TDATE")
+10 SET IBSTRNG=$$ST($$EX^IBATUTL(351.61,.05,$PIECE(IBDAT(0),"^",5)),IBSTRNG,"STATUS")
+11 SET IBSTRNG=$$ST($SELECT($PIECE(IBDAT(0),"^",12)["DGPM":"Inpatient",$PIECE(IBDAT(0),"^",12)["SCE":"Outpatient",$PIECE(IBDAT(0),"^",12)["RMPR":"Prosthetic",1:"Pharmacy"),IBSTRNG,"TYPE")
+12 SET IBSTRNG=$$ST($$EX^IBATUTL(351.61,.11,$PIECE(IBDAT(0),"^",11)),IBSTRNG,"FACILITY")
+13 SET IBSTRNG=$$ST("$"_$PIECE(IBDAT(6),"^",2),IBSTRNG,"AMOUNT")
+14 SET VALMCNT=$$SETVALM^IBATUTL(VALMCNT,IBSTRNG,IBIEN)
End DoDot:1
+15 IF 'VALMCNT
DO SET^VALM10(1," ")
DO SET^VALM10(2,"No transactions meet criteria")
SET VALMCNT=2
+16 KILL ^TMP("IBAT",$JOB)
+17 QUIT
ST(A,B,C) ; -- calls VALM1 to set string up
+1 ;
+2 QUIT $$SETFLD^VALM1($$LOWER^VALM1(A),B,C)
