source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFN6.m@ 1578

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

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1IBDFN6 ;ALB/CJM - ENCOUNTER FORM - INTERFACE ROUTINES ;NOV 16,1992
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3ADDRESS ;returns address, telephone
4 ;input variables - DFN
5 N ARY,CNT,LINE S CNT=1
6 S ARY="^TMP(""IB"",$J,""INTERFACES"",+$G(DFN))"
7 D ADD^VADPT
8 I VAERR S (@ARY@("DPT PATIENT ADDRESS LINES"),@ARY@("DPT PATIENT'S TELEPHONE NUMBER"),@ARY@("DPT PATIENT SHORT ADDRESS"))="" Q
9 I VAPA(1)'="" S @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(1),CNT=CNT+1
10 I VAPA(2)'="" S @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(2),CNT=CNT+1
11 I VAPA(3)'="" S @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(3),CNT=CNT+1
12 S @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(4)_", "_$P(VAPA(5),"^",2)_" "_$P(VAPA(11),"^",2)
13 ;
14 ;short address
15 F CNT=1:1:3 S LINE=VAPA(CNT) Q:LINE'=""
16 S @ARY@("DPT PATIENT SHORT ADDRESS")=LINE_","_VAPA(4)_", "_$P(VAPA(5),"^",2)_" "_$P(VAPA(11),"^",2)
17 ;
18 S @ARY@("DPT PATIENT'S TELEPHONE NUMBER")=VAPA(8)
19 K VAPA,VA,VAERR,VAEL
20 Q
21 ;
22INSURANC ;returns all sorts of insurance information
23 ;input - DFN,ACT
24 ;ACT="" to return all insurance, ACT=1 to return only active insurance, ACT=2 to return active insurance and insurance that will not reimburse (Medicare)
25 ;
26 Q:'$G(DFN)
27 N NODE,SUB,ITEM,ENTRY,DATE,ARY,WHO
28 I $L($T(ALL^IBCNS1)) D
29 .S ARY="^TMP(""IBDF"",$J,""INSURANCE"")"
30 .K @ARY
31 .D ALL^IBCNS1(DFN,ARY,$G(ACT))
32 ;
33 S SUB=0,ITEM=1,ENTRY="" F S SUB=$O(@ARY@(SUB)) Q:'SUB D
34 .S NODE=$G(@ARY@(SUB,0)) Q:NODE=""
35 .S:$P(NODE,"^") ENTRY=$P($G(^DIC(36,$P(NODE,"^"),0)),"^")
36 .S Y=$P(NODE,"^",4) I Y>0 D DD^%DT S $P(ENTRY,"^",2)=Y
37 .S $P(ENTRY,"^",3)=$P(NODE,"^",2)
38 .S $P(ENTRY,"^",4)=$P(NODE,"^",3)
39 .S $P(ENTRY,"^",5)=$P(NODE,"^",15)
40 .S $P(ENTRY,"^",6)=$P(NODE,"^",17)
41 .S WHO=$P(NODE,"^",6)
42 .S $P(ENTRY,"^",7)=$S(WHO="v":"APPLICANT",WHO="s":"SPOUSE",WHO="o":"OTHER",1:"")
43 .S @IBARY@(ITEM)=ENTRY
44 .S ITEM=ITEM+1
45 K @ARY
46 Q
47 ;
48INSURED ;is the patient insured?
49 ;input - DFN
50 Q:'$G(DFN)
51 N INS S INS=""
52 ;do it the new way?
53 I $L($T(INSURED^IBCNS1)) D
54 .S INS=$$INSURED^IBCNS1(DFN)
55 S @IBARY=$S(INS=1:"YES",INS=0:"NO",1:"UNKNOWN")
56 Q
Note: See TracBrowser for help on using the repository browser.