Routine: VPRSDAIB

VPRSDAIB ;SLC/MKB,MRY -- Integrated Billing utilities ;10/18/22  14:11

 ;;1.0;VIRTUAL PATIENT RECORD;**31**;Sep 01, 2011;Build 3

 ;;Per VHA Directive 6402, this routine should not be modified.

 ; External References          DBIA#

 ; -------------------          -----

 ; IBBAPI                        4419

INQ ; -- Insurance query, creates VPRINS and DLIST arrays

 ; Expects DSTRT, DSTOP, DMAX from DDEGET and returns DLIST(#)=ien

 N NUM,I,VPRDT,VPRSTS,VPRX,IEN,CNT

 S VPRSTS=$G(FILTER("status"),"ARB"),VPRDT=DT,CNT=0

 I VPRSTS["A" S VPRDT="" ;no date if requesting inactive policies

 S:$G(DFN) NUM=$$INSUR^IBBAPI(DFN,VPRDT,VPRSTS,.VPRX,"*") Q:NUM<1

 S I=0 F  S I=$O(VPRX("IBBAPI","INSUR",I)) Q:(I<1)!(CNT>=DMAX)  D

 . I DSTRT,VPRX("IBBAPI","INSUR",I,10)<DSTRT Q  ;Effective date

 . I DSTOP,VPRX("IBBAPI","INSUR",I,10)>DSTOP Q  ;Effective date

 . S IEN=+$G(VPRX("IBBAPI","INSUR",I))

 . S DLIST(I)=IEN_","_DFN,CNT=CNT+1

 M VPRINS=VPRX("IBBAPI","INSUR")

INS1(IEN) ; -- set up one insurance record

 ; Returns VPRP = # in VPRINS(#) of current record

 N I K VPRP

 I '$G(IEN)!'$G(DFN) S DDEOUT=1 Q

 I '$D(VPRINS) D   ;create VPRINS array if needed

 . N NUM,VPRDT,VPRSTS,VPRX

 . S VPRDT="",VPRSTS="ARB" ;all policies

 . S NUM=$$INSUR^IBBAPI(DFN,VPRDT,VPRSTS,.VPRX,"*")

 . I NUM M VPRINS=VPRX("IBBAPI","INSUR")

 S I=0 F  S I=$O(VPRINS(I)) Q:I<1  I +$G(VPRINS(I))=+IEN S VPRP=I Q

 I '$G(VPRP) S DDEOUT=1 Q

DEL ; -- ID Action for Delete entity

 ; Expects DIEN, AVPR seq# in FILTER("sequence")

 ; Returns VPRIB(#)=data nodes, VPRINS(#)=IBBAPI data elements

 N SEQ K VPRIB,VPRINS

 S SEQ=+$G(FILTER("sequence"))

 I SEQ,$G(DIEN) D

 . M VPRIB=^XTMP("VPR-"_SEQ,DIEN)

 . S VPRINS(1)=$P($G(VPRIB(0)),"^",1)  ;Ins. Comp. ien

 . S VPRINS(8)=$P($G(VPRIB(0)),"^",18) ;Policy ien

 . S VPRINS(14)=$P($G(VPRIB(7)),"^",2) ;Subscriber ID

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRSDAIB   1879     printed  Feb 19, 2025@00:12:20                                                                                                                                                                                                    Page 2

VPRSDAIB  ;SLC/MKB,MRY -- Integrated Billing utilities ;10/18/22  14:11

 +1       ;;1.0;VIRTUAL PATIENT RECORD;**31**;Sep 01, 2011;Build 3

 +2       ;;Per VHA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; External References          DBIA#

 +5       ; -------------------          -----

 +6       ; IBBAPI                        4419

 +7       ;

INQ       ; -- Insurance query, creates VPRINS and DLIST arrays

 +1       ; Expects DSTRT, DSTOP, DMAX from DDEGET and returns DLIST(#)=ien

 +2        NEW NUM,I,VPRDT,VPRSTS,VPRX,IEN,CNT

 +3        SET VPRSTS=$GET(FILTER("status"),"ARB")

           SET VPRDT=DT

           SET CNT=0

 +4       ;no date if requesting inactive policies

           IF VPRSTS["A"

               SET VPRDT=""

 +5        if $GET(DFN)

               SET NUM=$$INSUR^IBBAPI(DFN,VPRDT,VPRSTS,.VPRX,"*")

           if NUM<1

               QUIT

 +6        SET I=0

FOR

               SET I=$ORDER(VPRX("IBBAPI","INSUR",I))

               if (I<1)!(CNT>=DMAX)

                   QUIT

               Begin DoDot:1

 +7       ;Effective date

                   IF DSTRT

                       IF VPRX("IBBAPI","INSUR",I,10)<DSTRT

                           QUIT

 +8       ;Effective date

                   IF DSTOP

                       IF VPRX("IBBAPI","INSUR",I,10)>DSTOP

                           QUIT

 +9                SET IEN=+$GET(VPRX("IBBAPI","INSUR",I))

 +10               SET DLIST(I)=IEN_","_DFN

                   SET CNT=CNT+1

               End DoDot:1

 +11       MERGE VPRINS=VPRX("IBBAPI","INSUR")

 +12       QUIT

 +13      ;

INS1(IEN) ; -- set up one insurance record

 +1       ; Returns VPRP = # in VPRINS(#) of current record

 +2        NEW I

           KILL VPRP

 +3        IF '$GET(IEN)!'$GET(DFN)

               SET DDEOUT=1

               QUIT

 +4       ;create VPRINS array if needed

           IF '$DATA(VPRINS)

               Begin DoDot:1

 +5                NEW NUM,VPRDT,VPRSTS,VPRX

 +6       ;all policies

                   SET VPRDT=""

                   SET VPRSTS="ARB"

 +7                SET NUM=$$INSUR^IBBAPI(DFN,VPRDT,VPRSTS,.VPRX,"*")

 +8                IF NUM

                       MERGE VPRINS=VPRX("IBBAPI","INSUR")

               End DoDot:1

 +9        SET I=0

FOR

               SET I=$ORDER(VPRINS(I))

               if I<1

                   QUIT

               IF +$GET(VPRINS(I))=+IEN

                   SET VPRP=I

                   QUIT

 +10       IF '$GET(VPRP)

               SET DDEOUT=1

               QUIT

 +11       QUIT

 +12      ;

DEL       ; -- ID Action for Delete entity

 +1       ; Expects DIEN, AVPR seq# in FILTER("sequence")

 +2       ; Returns VPRIB(#)=data nodes, VPRINS(#)=IBBAPI data elements

 +3        NEW SEQ

           KILL VPRIB,VPRINS

 +4        SET SEQ=+$GET(FILTER("sequence"))

 +5        IF SEQ

               IF $GET(DIEN)

                   Begin DoDot:1

 +6                    MERGE VPRIB=^XTMP("VPR-"_SEQ,DIEN)

 +7       ;Ins. Comp. ien

                       SET VPRINS(1)=$PIECE($GET(VPRIB(0)),"^",1)

 +8       ;Policy ien

                       SET VPRINS(8)=$PIECE($GET(VPRIB(0)),"^",18)

 +9       ;Subscriber ID

                       SET VPRINS(14)=$PIECE($GET(VPRIB(7)),"^",2)

                   End DoDot:1

 +10       QUIT

VPRSDAIB.m