- 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 Mar 13, 2025@21:49:33 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
