IBATLM0 ;LL/ELZ - TRANSFER PRICING PT LIST LIST MANAGER ; 29-JAN-1999
;;2.0;INTEGRATED BILLING;**115**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN(IBINST) ; -- main entry point for IBAT PATIENT LIST
S $P(IBINST,"^",2)=$$GET1^DIQ(4,IBINST,.01)
D EN^VALM("IBAT PATIENT LIST")
Q
;
HDR ; -- header code
S VALMHDR(1)="Patients with an Enrolled "_$S(IBINST["VISN":"VISN",1:"Facility")_" of "_$P(IBINST,"^",2)
Q
;
INIT ; -- init variables and list array
K ^TMP("VALM DATA",$J),^TMP("VALMAR",$J),^TMP("IBAT0",$J)
N IBIEN,IBDAT,IBSTRNG,IBNAM,IBXREF,IBCNT
S IBXREF=$S($E($P(IBINST,"^",2),1,4)="VISN":"AC",1:"AD"),IBCNT=0
W !,"Building List"
S IBIEN=0 F S IBIEN=$O(^IBAT(351.6,IBXREF,+IBINST,IBIEN)) Q:IBIEN<1 S ^TMP("IBAT0",$J,$P(^DPT(IBIEN,0),"^"),IBIEN)="",IBCNT=IBCNT+1 W:'(IBCNT#100) "."
S VALMCNT=0,IBNAM=""
F S IBNAM=$O(^TMP("IBAT0",$J,IBNAM)) Q:IBNAM="" S IBIEN=0 F S IBIEN=$O(^(IBNAM,IBIEN)) Q:IBIEN<1 D
. S IBDAT=$G(^IBAT(351.6,IBIEN,0)) Q:IBDAT=""
. S IBSTRNG=""
. S IBSTRNG=$$ST(VALMCNT+1,IBSTRNG,"ITEM")
. S IBSTRNG=$$ST($P(^DPT(+IBDAT,0),"^"),IBSTRNG,"NAME")
. S IBSTRNG=$$ST($$EX^IBATUTL(351.6,.04,$P(IBDAT,"^",4)),IBSTRNG,"STATUS")
. S IBSTRNG=$$ST($P($P($$INST^IBATUTL($S($P(IBDAT,"^",10):$P(IBDAT,"^",10),1:$P(IBDAT,"^",3))),"^"),","),IBSTRNG,"FAC")
. S IBSTRNG=$$ST($$DAT1^IBOUTL($P(IBDAT,"^",5)),IBSTRNG,"INPT")
. S IBSTRNG=$$ST($$DAT1^IBOUTL($P(IBDAT,"^",6)),IBSTRNG,"OUT")
. S IBSTRNG=$$ST($$DAT1^IBOUTL($P(IBDAT,"^",7)),IBSTRNG,"RX")
. S IBSTRNG=$$ST($S($$INSURED^IBCNS1(+IBDAT):" Y",1:" N"),IBSTRNG,"INS")
. S VALMCNT=$$SETVALM^IBATUTL(VALMCNT,IBSTRNG,IBIEN)
. S IBCNT=IBCNT+1 W:'(IBCNT#100) "."
I 'VALMCNT D SET^VALM10(1," "),SET^VALM10(2,"No Patients found") S VALMCNT=2
K ^TMP("IBAT0",$J)
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("VALM DATA",$J),^TMP("VALMAR",$J)
Q
;
EXPND ; -- expand code
Q
;
ST(A,B,C) ; -- calls VALM1 to set up string
Q $$SETFLD^VALM1($$LOWER^VALM1(A),B,C)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBATLM0 2072 printed Apr 09, 2024@21:28:15 Page 2
IBATLM0 ;LL/ELZ - TRANSFER PRICING PT LIST LIST MANAGER ; 29-JAN-1999
+1 ;;2.0;INTEGRATED BILLING;**115**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN(IBINST) ; -- main entry point for IBAT PATIENT LIST
+1 SET $PIECE(IBINST,"^",2)=$$GET1^DIQ(4,IBINST,.01)
+2 DO EN^VALM("IBAT PATIENT LIST")
+3 QUIT
+4 ;
HDR ; -- header code
+1 SET VALMHDR(1)="Patients with an Enrolled "_$SELECT(IBINST["VISN":"VISN",1:"Facility")_" of "_$PIECE(IBINST,"^",2)
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("VALM DATA",$JOB),^TMP("VALMAR",$JOB),^TMP("IBAT0",$JOB)
+2 NEW IBIEN,IBDAT,IBSTRNG,IBNAM,IBXREF,IBCNT
+3 SET IBXREF=$SELECT($EXTRACT($PIECE(IBINST,"^",2),1,4)="VISN":"AC",1:"AD")
SET IBCNT=0
+4 WRITE !,"Building List"
+5 SET IBIEN=0
FOR
SET IBIEN=$ORDER(^IBAT(351.6,IBXREF,+IBINST,IBIEN))
if IBIEN<1
QUIT
SET ^TMP("IBAT0",$JOB,$PIECE(^DPT(IBIEN,0),"^"),IBIEN)=""
SET IBCNT=IBCNT+1
if '(IBCNT#100)
WRITE "."
+6 SET VALMCNT=0
SET IBNAM=""
+7 FOR
SET IBNAM=$ORDER(^TMP("IBAT0",$JOB,IBNAM))
if IBNAM=""
QUIT
SET IBIEN=0
FOR
SET IBIEN=$ORDER(^(IBNAM,IBIEN))
if IBIEN<1
QUIT
Begin DoDot:1
+8 SET IBDAT=$GET(^IBAT(351.6,IBIEN,0))
if IBDAT=""
QUIT
+9 SET IBSTRNG=""
+10 SET IBSTRNG=$$ST(VALMCNT+1,IBSTRNG,"ITEM")
+11 SET IBSTRNG=$$ST($PIECE(^DPT(+IBDAT,0),"^"),IBSTRNG,"NAME")
+12 SET IBSTRNG=$$ST($$EX^IBATUTL(351.6,.04,$PIECE(IBDAT,"^",4)),IBSTRNG,"STATUS")
+13 SET IBSTRNG=$$ST($PIECE($PIECE($$INST^IBATUTL($SELECT($PIECE(IBDAT,"^",10):$PIECE(IBDAT,"^",10),1:$PIECE(IBDAT,"^",3))),"^"),","),IBSTRNG,"FAC")
+14 SET IBSTRNG=$$ST($$DAT1^IBOUTL($PIECE(IBDAT,"^",5)),IBSTRNG,"INPT")
+15 SET IBSTRNG=$$ST($$DAT1^IBOUTL($PIECE(IBDAT,"^",6)),IBSTRNG,"OUT")
+16 SET IBSTRNG=$$ST($$DAT1^IBOUTL($PIECE(IBDAT,"^",7)),IBSTRNG,"RX")
+17 SET IBSTRNG=$$ST($SELECT($$INSURED^IBCNS1(+IBDAT):" Y",1:" N"),IBSTRNG,"INS")
+18 SET VALMCNT=$$SETVALM^IBATUTL(VALMCNT,IBSTRNG,IBIEN)
+19 SET IBCNT=IBCNT+1
if '(IBCNT#100)
WRITE "."
End DoDot:1
+20 IF 'VALMCNT
DO SET^VALM10(1," ")
DO SET^VALM10(2,"No Patients found")
SET VALMCNT=2
+21 KILL ^TMP("IBAT0",$JOB)
+22 QUIT
+23 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("VALM DATA",$JOB),^TMP("VALMAR",$JOB)
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
ST(A,B,C) ; -- calls VALM1 to set up string
+1 QUIT $$SETFLD^VALM1($$LOWER^VALM1(A),B,C)
