source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBATLM3.m@ 808

Last change on this file since 808 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.0 KB
Line 
1IBATLM3 ;LL/ELZ - TRANSFER PRICING PATIENT INFO SCREEN ; 13-APR-1999
2 ;;2.0;INTEGRATED BILLING;**115**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; -- main entry point for IBAT PATIENT DETAIL
6 D EN^VALM("IBAT PATIENT DETAIL")
7 Q
8 ;
9HDR ; -- header code
10 N IBDFN0,IBAT0,VA
11 ;
12 S IBDFN0=^DPT(DFN,0),IBAT0=^IBAT(351.6,DFN,0)
13 D PID^VADPT
14 ;
15 S VALMHDR(1)="Name: "_$P(IBDFN0,"^")
16 D SET("SSN: "_VA("PID"),.VALMHDR,1,54,26,0)
17 ;
18 D SET("Current TP Status:",.VALMHDR,2,1,18,0)
19 D SET($$EX^IBATUTL(351.6,.04,$P(IBAT0,"^",4)),.VALMHDR,2,20,40,1)
20 D SET("Enrolled Facility:",.VALMHDR,2,40,18,0)
21 D SET($P($$INST^IBATUTL($$PPF^IBATUTL(DFN)),"^"),.VALMHDR,2,59,20,1)
22 Q
23 ;
24INIT ; -- init variables and list array
25 S VALMCNT=0
26 D ^IBATLM3A
27 Q
28 ;
29HELP ; -- help code
30 S X="?" D DISP^XQORM1 W !!
31 Q
32 ;
33EXIT ; -- exit code
34 Q
35 ;
36EXPND ; -- expand code
37 Q
38 ;
39SET(TEXT,STRING,S,COL,LENGTH,L) ; -- set up string with valm1
40 I '$D(STRING(S)) S STRING(S)=""
41 I L S TEXT=$$LOWER^VALM1(TEXT)
42 S STRING(S)=$$SETSTR^VALM1(TEXT,STRING(S),COL,LENGTH)
43 Q
Note: See TracBrowser for help on using the repository browser.