- 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 Feb 18, 2025@23:34:16 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)