IBDFN6 ;ALB/CJM - ENCOUNTER FORM - INTERFACE ROUTINES ;NOV 16,1992
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
ADDRESS ;returns address, telephone
;input variables - DFN
N ARY,CNT,LINE S CNT=1
S ARY="^TMP(""IB"",$J,""INTERFACES"",+$G(DFN))"
D ADD^VADPT
I VAERR S (@ARY@("DPT PATIENT ADDRESS LINES"),@ARY@("DPT PATIENT'S TELEPHONE NUMBER"),@ARY@("DPT PATIENT SHORT ADDRESS"))="" Q
I VAPA(1)'="" S @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(1),CNT=CNT+1
I VAPA(2)'="" S @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(2),CNT=CNT+1
I VAPA(3)'="" S @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(3),CNT=CNT+1
S @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(4)_", "_$P(VAPA(5),"^",2)_" "_$P(VAPA(11),"^",2)
;
;short address
F CNT=1:1:3 S LINE=VAPA(CNT) Q:LINE'=""
S @ARY@("DPT PATIENT SHORT ADDRESS")=LINE_","_VAPA(4)_", "_$P(VAPA(5),"^",2)_" "_$P(VAPA(11),"^",2)
;
S @ARY@("DPT PATIENT'S TELEPHONE NUMBER")=VAPA(8)
K VAPA,VA,VAERR,VAEL
Q
;
INSURANC ;returns all sorts of insurance information
;input - DFN,ACT
;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)
;
Q:'$G(DFN)
N NODE,SUB,ITEM,ENTRY,DATE,ARY,WHO
I $L($T(ALL^IBCNS1)) D
.S ARY="^TMP(""IBDF"",$J,""INSURANCE"")"
.K @ARY
.D ALL^IBCNS1(DFN,ARY,$G(ACT))
;
S SUB=0,ITEM=1,ENTRY="" F S SUB=$O(@ARY@(SUB)) Q:'SUB D
.S NODE=$G(@ARY@(SUB,0)) Q:NODE=""
.S:$P(NODE,"^") ENTRY=$P($G(^DIC(36,$P(NODE,"^"),0)),"^")
.S Y=$P(NODE,"^",4) I Y>0 D DD^%DT S $P(ENTRY,"^",2)=Y
.S $P(ENTRY,"^",3)=$P(NODE,"^",2)
.S $P(ENTRY,"^",4)=$P(NODE,"^",3)
.S $P(ENTRY,"^",5)=$P(NODE,"^",15)
.S $P(ENTRY,"^",6)=$P(NODE,"^",17)
.S WHO=$P(NODE,"^",6)
.S $P(ENTRY,"^",7)=$S(WHO="v":"APPLICANT",WHO="s":"SPOUSE",WHO="o":"OTHER",1:"")
.S @IBARY@(ITEM)=ENTRY
.S ITEM=ITEM+1
K @ARY
Q
;
INSURED ;is the patient insured?
;input - DFN
Q:'$G(DFN)
N INS S INS=""
;do it the new way?
I $L($T(INSURED^IBCNS1)) D
.S INS=$$INSURED^IBCNS1(DFN)
S @IBARY=$S(INS=1:"YES",INS=0:"NO",1:"UNKNOWN")
Q
IBDFN6 ;ALB/CJM - ENCOUNTER FORM - INTERFACE ROUTINES ;NOV 16,1992
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
ADDRESS ;returns address, telephone
+1 ;input variables - DFN
+2 NEW ARY,CNT,LINE
SET CNT=1
+3 SET ARY="^TMP(""IB"",$J,""INTERFACES"",+$G(DFN))"
+4 DO ADD^VADPT
+5 IF VAERR
SET (@ARY@("DPT PATIENT ADDRESS LINES"),@ARY@("DPT PATIENT'S TELEPHONE NUMBER"),@ARY@("DPT PATIENT SHORT ADDRESS"))=""
QUIT
+6 IF VAPA(1)'=""
SET @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(1)
SET CNT=CNT+1
+7 IF VAPA(2)'=""
SET @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(2)
SET CNT=CNT+1
+8 IF VAPA(3)'=""
SET @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(3)
SET CNT=CNT+1
+9 SET @ARY@("DPT PATIENT ADDRESS LINES",CNT)=VAPA(4)_", "_$PIECE(VAPA(5),"^",2)_" "_$PIECE(VAPA(11),"^",2)
+10 ;
+11 ;short address
+12 FOR CNT=1:1:3
SET LINE=VAPA(CNT)
IF LINE'=""
QUIT
+13 SET @ARY@("DPT PATIENT SHORT ADDRESS")=LINE_","_VAPA(4)_", "_$PIECE(VAPA(5),"^",2)_" "_$PIECE(VAPA(11),"^",2)
+14 ;
+15 SET @ARY@("DPT PATIENT'S TELEPHONE NUMBER")=VAPA(8)
+16 KILL VAPA,VA,VAERR,VAEL
+17 QUIT
+18 ;
INSURANC ;returns all sorts of insurance information
+1 ;input - DFN,ACT
+2 ;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)
+3 ;
+4 IF '$GET(DFN)
QUIT
+5 NEW NODE,SUB,ITEM,ENTRY,DATE,ARY,WHO
+6 IF $LENGTH($TEXT(ALL^IBCNS1))
Begin DoDot:1
+7 SET ARY="^TMP(""IBDF"",$J,""INSURANCE"")"
+8 KILL @ARY
+9 DO ALL^IBCNS1(DFN,ARY,$GET(ACT))
End DoDot:1
+10 ;
+11 SET SUB=0
SET ITEM=1
SET ENTRY=""
FOR
SET SUB=$ORDER(@ARY@(SUB))
IF 'SUB
QUIT
Begin DoDot:1
+12 SET NODE=$GET(@ARY@(SUB,0))
IF NODE=""
QUIT
+13 IF $PIECE(NODE,"^")
SET ENTRY=$PIECE($GET(^DIC(36,$PIECE(NODE,"^"),0)),"^")
+14 SET Y=$PIECE(NODE,"^",4)
IF Y>0
DO DD^%DT
SET $PIECE(ENTRY,"^",2)=Y
+15 SET $PIECE(ENTRY,"^",3)=$PIECE(NODE,"^",2)
+16 SET $PIECE(ENTRY,"^",4)=$PIECE(NODE,"^",3)
+17 SET $PIECE(ENTRY,"^",5)=$PIECE(NODE,"^",15)
+18 SET $PIECE(ENTRY,"^",6)=$PIECE(NODE,"^",17)
+19 SET WHO=$PIECE(NODE,"^",6)
+20 SET $PIECE(ENTRY,"^",7)=$SELECT(WHO="v":"APPLICANT",WHO="s":"SPOUSE",WHO="o":"OTHER",1:"")
+21 SET @IBARY@(ITEM)=ENTRY
+22 SET ITEM=ITEM+1
End DoDot:1
+23 KILL @ARY
+24 QUIT
+25 ;
INSURED ;is the patient insured?
+1 ;input - DFN
+2 IF '$GET(DFN)
QUIT
+3 NEW INS
SET INS=""
+4 ;do it the new way?
+5 IF $LENGTH($TEXT(INSURED^IBCNS1))
Begin DoDot:1
+6 SET INS=$$INSURED^IBCNS1(DFN)
End DoDot:1
+7 SET @IBARY=$SELECT(INS=1:"YES",INS=0:"NO",1:"UNKNOWN")
+8 QUIT
