VPRDIB ;SLC/MKB -- Integrated Billing (insurance) ;3/14/12 09:01
;;1.0;VIRTUAL PATIENT RECORD;**1,5**;Sep 01,2011;Build 21
;
; External References DBIA#
; ------------------- -----
; IBBAPI 4419
;
;
; ------------ Get data from VistA ------------
;
EN(DFN,BEG,END,MAX,ID) ; -- find patient's insurance data
; [END,ID not currently used]
N X,I,VPRX,VPRITM,VPRCNT,VPRINS,VPRDT,VPRSTS
S DFN=+$G(DFN) Q:DFN<1
S MAX=$G(MAX,9999),VPRDT=DT
; $G(BEG),BEG>2000000 S VPRDT=BEG
S VPRSTS=$G(FILTER("status"),"RB")
I VPRSTS["A" S VPRDT="" ;no date if requesting inactive policies
;
; get one policy
;I $G(ID) D EN1(ID,.VPRITM),XML(.VPRITM) Q
;
; get all policies
S X=$$INSUR^IBBAPI(DFN,VPRDT,VPRSTS,.VPRX,"*") Q:X<1
S (I,VPRCNT)=0 F S I=$O(VPRX("IBBAPI","INSUR",I)) Q:I<1 D Q:VPRCNT'<MAX
. M VPRINS=VPRX("IBBAPI","INSUR",I) K VPRITM
. I $G(ID),DFN'=+ID!(+VPRINS(1)'=$P(ID,";",2))!(+VPRINS(8)'=$P(ID,";",3)) Q
. S VPRITM("id")=DFN_";"_+VPRINS(1)_";"_+VPRINS(8) ; = DFN;COMPANY;POLICY
. S VPRITM("company")=VPRINS(1),X=VPRINS(2)
. F J=23,24,3,4,5 S X=X_U_VPRINS(J)
. S VPRITM("company","address")=X
. S X=VPRINS(6) S:$L(X) VPRITM("company","telecom")=$$FORMAT(X)
. S VPRITM("effectiveDate")=VPRINS(10)
. S VPRITM("expirationDate")=VPRINS(11)
. S VPRITM("groupName")=$P(VPRINS(8),U,2)
. S VPRITM("groupNumber")=VPRINS(18)
. S X=VPRINS(21),VPRITM("insuranceType")=X
. ; VPRITM("insuranceType")=$$GET^XPAR(355.1,+X_",",.03) ;Maj Catg
. S VPRITM("relationship")=$P(VPRINS(19),U,2)
. S VPRITM("subscriber")=VPRINS(14)_U_VPRINS(13)
. ; VPRITM("subscriber","address")
. ; VPRITM("subscriber","telecom")
. ; VPRITM("memberID")
. S VPRITM("facility")=$$FAC^VPRD ;local stn#^name
. D XML(.VPRITM) S VPRCNT=VPRCNT+1
Q
;
FORMAT(X) ; -- enforce (xxx)xxx-xxxx phone format
S X=$G(X) I X?1"("3N1")"3N1"-"4N.E Q X
N P,N,I,Y S P=""
F I=1:1:$L(X) S N=$E(X,I) I N=+N S P=P_N
S:$L(P)<10 P=$E("0000000000",1,10-$L(P))_P
S Y=$S(P:"("_$E(P,1,3)_")"_$E(P,4,6)_"-"_$E(P,7,10),1:"")
Q Y
;
; ------------ Return data to middle tier ------------
;
XML(ITEM) ; -- Return patient data as XML in @VPR@(n)
; as <element code='123' displayName='ABC' />
N ATT,X,Y,I,SUB
D ADD("<insurancePolicy>") S VPRTOTL=$G(VPRTOTL)+1
S ATT="" F S ATT=$O(ITEM(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
. S X=$G(ITEM(ATT)),Y="" Q:'$L(X)
. I X'["^" S Y="<"_ATT_" value='"_$$ESC^VPRD(X)
. I $L(X,"^")>1 S Y="<"_ATT_" code='"_$P(X,U)_"' name='"_$$ESC^VPRD($P(X,U,2))
. S SUB=$O(ITEM(ATT,"")) I SUB="" S Y=Y_"' />" Q
. S Y=Y_"' >" D ADD(Y) S X=$G(ITEM(ATT,SUB))
. I SUB="address" D ADDR(X)
. I SUB="telecom" D PHONE(X)
. S Y="</"_ATT_">"
D ADD("</insurancePolicy>")
Q
;
ADDR(X) ; -- XML address node from X=street1^st2^st3^city^state^zip
N I,Y Q:$L(X)'>5 ;no data
S Y="<address"
F I=1,2,3 I $L($P(X,U,I)) S Y=Y_" streetLine"_I_"='"_$$ESC^VPRD($P(X,U,I))_"'"
I $L($P(X,U,4)) S Y=Y_" city='"_$$ESC^VPRD($P(X,U,4))_"'"
I $L($P(X,U,5)) S Y=Y_" stateProvince='"_$P(X,U,5)_"'"
I $L($P(X,U,6)) S Y=Y_" postalCode='"_$P(X,U,6)_"'"
S Y=Y_" />" D ADD(Y)
Q
;
PHONE(X) ; -- XML telecom node from X=home^cell^work numbers
N I,Y Q:$L(X)'>2 ;no data
D ADD("<telecomList>")
I $L($P(X,U,1)) S Y="<telecom usageType='H' value='"_$P(X,U,1)_"' />" D ADD(Y)
I $L($P(X,U,2)) S Y="<telecom usageType='MC' value='"_$P(X,U,2)_"' />" D ADD(Y)
I $L($P(X,U,3)) S Y="<telecom usageType='WP' value='"_$P(X,U,3)_"' />" D ADD(Y)
D ADD("</telecomList>")
Q
;
ADD(X) ; Add a line @VPR@(n)=X
S VPRI=$G(VPRI)+1
S @VPR@(VPRI)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRDIB 3649 printed Apr 09, 2024@21:47:06 Page 2
VPRDIB ;SLC/MKB -- Integrated Billing (insurance) ;3/14/12 09:01
+1 ;;1.0;VIRTUAL PATIENT RECORD;**1,5**;Sep 01,2011;Build 21
+2 ;
+3 ; External References DBIA#
+4 ; ------------------- -----
+5 ; IBBAPI 4419
+6 ;
+7 ;
+8 ; ------------ Get data from VistA ------------
+9 ;
EN(DFN,BEG,END,MAX,ID) ; -- find patient's insurance data
+1 ; [END,ID not currently used]
+2 NEW X,I,VPRX,VPRITM,VPRCNT,VPRINS,VPRDT,VPRSTS
+3 SET DFN=+$GET(DFN)
if DFN<1
QUIT
+4 SET MAX=$GET(MAX,9999)
SET VPRDT=DT
+5 ; $G(BEG),BEG>2000000 S VPRDT=BEG
+6 SET VPRSTS=$GET(FILTER("status"),"RB")
+7 ;no date if requesting inactive policies
IF VPRSTS["A"
SET VPRDT=""
+8 ;
+9 ; get one policy
+10 ;I $G(ID) D EN1(ID,.VPRITM),XML(.VPRITM) Q
+11 ;
+12 ; get all policies
+13 SET X=$$INSUR^IBBAPI(DFN,VPRDT,VPRSTS,.VPRX,"*")
if X<1
QUIT
+14 SET (I,VPRCNT)=0
FOR
SET I=$ORDER(VPRX("IBBAPI","INSUR",I))
if I<1
QUIT
Begin DoDot:1
+15 MERGE VPRINS=VPRX("IBBAPI","INSUR",I)
KILL VPRITM
+16 IF $GET(ID)
IF DFN'=+ID!(+VPRINS(1)'=$PIECE(ID,";",2))!(+VPRINS(8)'=$PIECE(ID,";",3))
QUIT
+17 ; = DFN;COMPANY;POLICY
SET VPRITM("id")=DFN_";"_+VPRINS(1)_";"_+VPRINS(8)
+18 SET VPRITM("company")=VPRINS(1)
SET X=VPRINS(2)
+19 FOR J=23,24,3,4,5
SET X=X_U_VPRINS(J)
+20 SET VPRITM("company","address")=X
+21 SET X=VPRINS(6)
if $LENGTH(X)
SET VPRITM("company","telecom")=$$FORMAT(X)
+22 SET VPRITM("effectiveDate")=VPRINS(10)
+23 SET VPRITM("expirationDate")=VPRINS(11)
+24 SET VPRITM("groupName")=$PIECE(VPRINS(8),U,2)
+25 SET VPRITM("groupNumber")=VPRINS(18)
+26 SET X=VPRINS(21)
SET VPRITM("insuranceType")=X
+27 ; VPRITM("insuranceType")=$$GET^XPAR(355.1,+X_",",.03) ;Maj Catg
+28 SET VPRITM("relationship")=$PIECE(VPRINS(19),U,2)
+29 SET VPRITM("subscriber")=VPRINS(14)_U_VPRINS(13)
+30 ; VPRITM("subscriber","address")
+31 ; VPRITM("subscriber","telecom")
+32 ; VPRITM("memberID")
+33 ;local stn#^name
SET VPRITM("facility")=$$FAC^VPRD
+34 DO XML(.VPRITM)
SET VPRCNT=VPRCNT+1
End DoDot:1
if VPRCNT'<MAX
QUIT
+35 QUIT
+36 ;
FORMAT(X) ; -- enforce (xxx)xxx-xxxx phone format
+1 SET X=$GET(X)
IF X?1"("3N1")"3N1"-"4N.E
QUIT X
+2 NEW P,N,I,Y
SET P=""
+3 FOR I=1:1:$LENGTH(X)
SET N=$EXTRACT(X,I)
IF N=+N
SET P=P_N
+4 if $LENGTH(P)<10
SET P=$EXTRACT("0000000000",1,10-$LENGTH(P))_P
+5 SET Y=$SELECT(P:"("_$EXTRACT(P,1,3)_")"_$EXTRACT(P,4,6)_"-"_$EXTRACT(P,7,10),1:"")
+6 QUIT Y
+7 ;
+8 ; ------------ Return data to middle tier ------------
+9 ;
XML(ITEM) ; -- Return patient data as XML in @VPR@(n)
+1 ; as <element code='123' displayName='ABC' />
+2 NEW ATT,X,Y,I,SUB
+3 DO ADD("<insurancePolicy>")
SET VPRTOTL=$GET(VPRTOTL)+1
+4 SET ATT=""
FOR
SET ATT=$ORDER(ITEM(ATT))
if ATT=""
QUIT
Begin DoDot:1
+5 SET X=$GET(ITEM(ATT))
SET Y=""
if '$LENGTH(X)
QUIT
+6 IF X'["^"
SET Y="<"_ATT_" value='"_$$ESC^VPRD(X)
+7 IF $LENGTH(X,"^")>1
SET Y="<"_ATT_" code='"_$PIECE(X,U)_"' name='"_$$ESC^VPRD($PIECE(X,U,2))
+8 SET SUB=$ORDER(ITEM(ATT,""))
IF SUB=""
SET Y=Y_"' />"
QUIT
+9 SET Y=Y_"' >"
DO ADD(Y)
SET X=$GET(ITEM(ATT,SUB))
+10 IF SUB="address"
DO ADDR(X)
+11 IF SUB="telecom"
DO PHONE(X)
+12 SET Y="</"_ATT_">"
End DoDot:1
if $LENGTH(Y)
DO ADD(Y)
+13 DO ADD("</insurancePolicy>")
+14 QUIT
+15 ;
ADDR(X) ; -- XML address node from X=street1^st2^st3^city^state^zip
+1 ;no data
NEW I,Y
if $LENGTH(X)'>5
QUIT
+2 SET Y="<address"
+3 FOR I=1,2,3
IF $LENGTH($PIECE(X,U,I))
SET Y=Y_" streetLine"_I_"='"_$$ESC^VPRD($PIECE(X,U,I))_"'"
+4 IF $LENGTH($PIECE(X,U,4))
SET Y=Y_" city='"_$$ESC^VPRD($PIECE(X,U,4))_"'"
+5 IF $LENGTH($PIECE(X,U,5))
SET Y=Y_" stateProvince='"_$PIECE(X,U,5)_"'"
+6 IF $LENGTH($PIECE(X,U,6))
SET Y=Y_" postalCode='"_$PIECE(X,U,6)_"'"
+7 SET Y=Y_" />"
DO ADD(Y)
+8 QUIT
+9 ;
PHONE(X) ; -- XML telecom node from X=home^cell^work numbers
+1 ;no data
NEW I,Y
if $LENGTH(X)'>2
QUIT
+2 DO ADD("<telecomList>")
+3 IF $LENGTH($PIECE(X,U,1))
SET Y="<telecom usageType='H' value='"_$PIECE(X,U,1)_"' />"
DO ADD(Y)
+4 IF $LENGTH($PIECE(X,U,2))
SET Y="<telecom usageType='MC' value='"_$PIECE(X,U,2)_"' />"
DO ADD(Y)
+5 IF $LENGTH($PIECE(X,U,3))
SET Y="<telecom usageType='WP' value='"_$PIECE(X,U,3)_"' />"
DO ADD(Y)
+6 DO ADD("</telecomList>")
+7 QUIT
+8 ;
ADD(X) ; Add a line @VPR@(n)=X
+1 SET VPRI=$GET(VPRI)+1
+2 SET @VPR@(VPRI)=X
+3 QUIT
