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")
Q
;
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
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRSDAIB 1879 printed Dec 13, 2024@02:45:53 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
