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

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1IBATLM3A ;LL/ELZ - TRANSFER PRICING PT INFO SCREEN BUILD ; 16-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 ;
5 N IBX,IBY,IBINPT,IBINS,IBCNT K ^TMP("IBATPT",$J)
6 ;
7 S IBCNT=0
8 S VAIP("D")="LAST" D A5^VADPT ; dbia 10061
9 S IBINPT=$G(^DPT(DFN,.105)) ; dbia 10035
10 S IBINS=$$INSURED^IBCNS1(DFN)
11 ;
12 S IBY=""
13 D SET("*** Demographic Information ***",.IBY,24,31)
14 D SETVALM(.VALMCNT,.IBY)
15 D CNTRL^VALM10(VALMCNT,24,31,IOINHI,IOINORM)
16 D SETVALM(.VALMCNT,"")
17 ;
18 D SET("Sex:",.IBY,21,4)
19 D SET($P(VADM(5),"^",2),.IBY,26,15)
20 D SET("Date of Birth:",.IBY,52,14)
21 D SET($P(VADM(3),"^",2),.IBY,67,13)
22 D SETVALM(.VALMCNT,.IBY)
23 ;
24 D SET("Primary Care Provider:",.IBY,3,22)
25 D SET($P($$OUTPTPR^SDUTL3(DFN),"^",2),.IBY,26,15) ; dbia 1252
26 D SET("Date of Death:",.IBY,52,14)
27 D SET($$DATE(+VADM(6)),.IBY,67,13)
28 D SETVALM(.VALMCNT,.IBY)
29 D SETVALM(.VALMCNT,"")
30 ;
31 D SET("Address:",.IBY,17,8)
32 F IBX=1:1:3 D:VAPA(IBX)'=""
33 . D SET(VAPA(IBX),.IBY,26,30)
34 . D SETVALM(.VALMCNT,.IBY)
35 D:IBY'="" SETVALM(.VALMCNT,.IBY)
36 ;
37 D SET(VAPA(4)_", "_$P(VAPA(5),"^",2)_" "_VAPA(6),.IBY,26,30)
38 D SETVALM(.VALMCNT,.IBY)
39 D SETVALM(.VALMCNT,"")
40 D SETVALM(.VALMCNT,"")
41 ;
42 D SET("*** Eligibility Information ***",.IBY,24,31)
43 D SETVALM(.VALMCNT,.IBY)
44 D CNTRL^VALM10(VALMCNT,24,31,IOINHI,IOINORM)
45 D SETVALM(.VALMCNT,"")
46 ;
47 D SET("Patient Type:",.IBY,12,13)
48 D SET($P(VAEL(6),"^",2),.IBY,26,15)
49 D SET("Means Test Status:",.IBY,48,18)
50 D SET($P(VAEL(9),"^",2),.IBY,67,13)
51 D SETVALM(.VALMCNT,.IBY)
52 ;
53 D SET("Primary Eligibility:",.IBY,5,20)
54 D SET($P(VAEL(1),"^",2),.IBY,26,15)
55 D SET("Enrollment Priority:",.IBY,46,31)
56 D SET($$PRIORITY^DGENA(DFN),.IBY,67,3) ; dbia #2918
57 D SETVALM(.VALMCNT,.IBY)
58 D SETVALM(.VALMCNT,"")
59 ;
60 D SET("Secondary Eligibilities:",.IBY,1,24)
61 S IBX=0 F S IBX=$O(VAEL(1,IBX)) Q:IBX<1 D
62 . D SET($P(VAEL(1,IBX),"^",2),.IBY,26,30)
63 . D SETVALM(.VALMCNT,.IBY)
64 D:IBY'="" SETVALM(.VALMCNT,.IBY)
65 D SETVALM(.VALMCNT,"")
66 ;
67 D SETVALM(.VALMCNT,"")
68 D SET("*** Insurance Information ***",.IBY,25,29)
69 D SETVALM(.VALMCNT,.IBY)
70 D CNTRL^VALM10(VALMCNT,25,29,IOINHI,IOINORM)
71 D SETVALM(.VALMCNT,"")
72 ;
73 I IBINS D ALL^IBCNS1(DFN,"^TMP(""IBINS"",$J)",1) D K ^TMP("IBINS",$J)
74 . S IBX=0 F S IBX=$O(^TMP("IBINS",$J,IBX)) Q:IBX<1 S IBX(0)=^(IBX,0) D
75 .. D SET($P(^DIC(36,+IBX(0),0),"^"),.IBY,5,30)
76 .. D SET($P(IBX(0),"^",2),.IBY,35,15)
77 .. I $P(IBX(0),"^",18),$D(^IBA(355.3,$P(IBX(0),"^",18),0)) D SET($P(^IBA(355.3,$P(IBX(0),"^",18),0),"^",3),.IBY,60,20)
78 .. D SETVALM(.VALMCNT,.IBY)
79 E D SET("Patient has no active insurance information",.IBY,5,75),SETVALM(.VALMCNT,.IBY)
80 D SETVALM(.VALMCNT,"")
81 ;
82 D SETVALM(.VALMCNT,"")
83 D SET("*** Inpatient Information ***",.IBY,26,29)
84 D SETVALM(.VALMCNT,.IBY)
85 D CNTRL^VALM10(VALMCNT,26,29,IOINHI,IOINORM)
86 D SETVALM(.VALMCNT,"")
87 ;
88 D SET("Inpatient Status:",.IBY,8,17)
89 D SET($S(IBINPT:"Active",1:"Inactive"),.IBY,26,10)
90 D SETVALM(.VALMCNT,.IBY)
91 ;
92 D SET("Last Admission:",.IBY,10,17)
93 D SET($S(VAIP(1)="":"Never Admitted",1:$P(VAIP(13,1),"^",2)),.IBY,26,17)
94 D SET("Ward Location:",.IBY,47,14)
95 D SET($P(VAIP(13,4),"^",2),.IBY,62,18)
96 D SETVALM(.VALMCNT,.IBY)
97 D SETVALM(.VALMCNT,"")
98 ;
99 D APPTS
100 ;
101 D KVAR^VADPT ; dbia 10061
102 ;
103 Q
104APPTS ; -- displays last 5 appointments
105 ;
106 D SETVALM(.VALMCNT,"")
107 D SET("*** Last Outpatient Appointments ***",.IBY,22,36)
108 D SETVALM(.VALMCNT,.IBY)
109 D CNTRL^VALM10(VALMCNT,22,36,IOINHI,IOINORM)
110 D SETVALM(.VALMCNT,"")
111 ;
112 N IBVAL,IBFILTER
113 S IBVAL("DFN")=DFN
114 S IBVAL("BDT")=0
115 S IBVAL("EDT")=$$NOW^XLFDT
116 ; screen children and inpatient encounters
117 S IBFILTER="I '$P(Y0,""^"",6),$P(Y0,""^"",12)'=8"
118 ;
119 D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,"D APPTCB^IBATLM3A",0,,"BACKWARD")
120 ;
121 Q
122APPTCB ; call back for scan to set up global
123 ;
124 D SET($$DATE($P(Y0,"^"),5),.IBY,5,17)
125 D SET($P(^SC($P(Y0,"^",4),0),"^"),.IBY,25,30) ; dbia 10040
126 D SET($$EX^IBATUTL(409.68,.12,$P(Y0,"^",12)),.IBY,60,20)
127 D SETVALM(.VALMCNT,.IBY)
128 ;
129 S IBCNT=IBCNT+1
130 S:IBCNT>4 SDSTOP=1
131 Q
132 ;
133SET(TEXT,STRING,COL,LENGTH) ; -- set up string with valm1
134 S STRING=$$SETSTR^VALM1($$LOWER^VALM1(TEXT),STRING,COL,LENGTH)
135 Q
136SETVALM(LINE,TEXT) ; -- sets line for display
137 S LINE=LINE+1
138 S ^TMP("IBATPT",$J,LINE,0)=TEXT
139 S TEXT=""
140 Q
141DATE(X,Y) ; -- returns date for display
142 S:'$D(Y) Y="5D"
143 Q $S(X:$$FMTE^XLFDT(X,Y),1:"")
Note: See TracBrowser for help on using the repository browser.