Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBATLM1A

IBATLM1A.m

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