IBCNEPM1 ;DAOU/ESG - PAYER MAINT/INS COMPANY LIST FOR PAYER ;22-JAN-2003
;;2.0;INTEGRATED BILLING;**184,416**;21-MAR-94;Build 58
;;Per VHA Directive 2004-038, this routine should not be modified.
;
EN(IEN,PAYER,PROFID,INSTID) ; -- main entry point for IBCNE PAYER EXPAND LIST
; IEN is the IEN of the Payer(#365.12). PAYER is the payer's name.
; PROFID and INSTID are the EDI ID numbers for the selected payer
; These are passed into this routine from EXPND^IBCNEPM2.
;
N IBCNEPRB
D EN^VALM("IBCNE PAYER EXPAND LIST") ; call the 2nd list
I $G(IBCNEPRB) D INIT^IBCNEPM G ENX ; special variable to rebuild the whole scratch global
D BUILD^IBCNEPM ; just rebuild the list#1 display
ENX ;
S VALMBCK="R"
Q
;
HDR ; -- header code
S VALMHDR(1)="PAYER: "_$E(PAYER,1,30)_" Prof. EDI#: "_$E($G(PROFID),1,15)_" Inst. EDI#: "_$E($G(INSTID),1,15)
S VALMHDR(2)="Insurance Company Name - Active Only"
Q
;
INIT ; -- init variables and list array
; Variable PAYER (payer name) is returned by this procedure and used
; by the list header. Variable LINE is also set before coming into
; this procedure.
;
KILL ^TMP("IBCNEPM",$J,2),^TMP("IBCNEPM",$J,"LINK")
NEW INS,ROW,STRING2,NAME,DATA,ADDRESS,DATA2,PROFID,INSTID
;
;IEN is the payer ien (#365.12)
;PAYER is the payer name
I IEN=""!(PAYER="") Q
;
; INS is the insurance company ien
S INS="",ROW=0
F S INS=$O(^TMP("IBCNEPM",$J,"PYR",PAYER,IEN,INS)) Q:INS="" D
. S STRING2="",ROW=ROW+1
. S NAME=$P($G(^DIC(36,INS,0)),U,1) ; insurance company name
. S DATA=$G(^DIC(36,INS,.11))
. S ADDRESS=$P(DATA,U,1)
. I $P(DATA,U,4)'="" S ADDRESS=ADDRESS_" "_$P(DATA,U,4)
. I $P(DATA,U,5) S ADDRESS=ADDRESS_","_$P($G(^DIC(5,+$P(DATA,U,5),0)),U,2)
. S DATA2=$G(^DIC(36,INS,3))
. S PROFID=$P(DATA2,U,2),INSTID=$P(DATA2,U,4)
. S STRING2=$$SETFLD^VALM1(NAME,STRING2,"INSURANCE CO")
. S STRING2=$$SETFLD^VALM1(ADDRESS,STRING2,"ADDRESS")
. S STRING2=$$SETFLD^VALM1(ROW,STRING2,"LINE")
. S STRING2=$$SETFLD^VALM1(PROFID,STRING2,"PROFEDI")
. S STRING2=$$SETFLD^VALM1(INSTID,STRING2,"INSTEDI")
. D SET^VALM10(ROW,STRING2)
. ;
. ; "LINK" scratch global structure = payer ien^ins co ien^payer name
. S ^TMP("IBCNEPM",$J,"LINK",ROW)=IEN_U_INS_U_PAYER
. Q
;
S VALMCNT=ROW
I VALMCNT=0 S VALMSG=" No Matching Insurance Companies "
Q
;
HELP ; -- help code
N X S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
LINK ; -- code to facilitate the linking between the ins company and payer
NEW DIR,X,Y,DIRUT,DIROUT,DTOUT,DUOUT,LINKDATA,PIEN,INS,TPAYER
NEW DA,DIE,DR,D,D0,DI,DIC,DISYS,DQ,%,PMCNT,PMLST,PMPCE,PMSEL,PMSUB
;
;PIEN - temp variable for payer IEN (#365.12)
;TPAYER - temp variable for payer name
;
D FULL^VALM1
I 'VALMCNT D G LINKX
. W !!?5,"There are no insurance companies to select."
. D PAUSE^VALM1
. Q
;
; If there is only one ins. company, then assume it's selection and skip the reader
I VALMCNT=1 S (Y,Y(0))="1," G L1
;
S DIR(0)="LO^1:"_VALMCNT_":0"
S DIR("A")="Select 1 or more Insurance Company Entries"
W ! D ^DIR K DIR
I $D(DIRUT) G LINKX
L1 ;
M PMLST=Y S PMCNT=0,TPAYER=""
F PMSUB=0:1 Q:'$D(PMLST(PMSUB)) F PMPCE=1:1 S PMSEL=$P(PMLST(PMSUB),",",PMPCE) Q:PMSEL="" D
. ; this is the loop that counts up the numbers selected for display purposes
. S PMCNT=PMCNT+1
. I TPAYER'="" Q
. S LINKDATA=$G(^TMP("IBCNEPM",$J,"LINK",+PMSEL)) I LINKDATA="" Q
. S PIEN=+$P(LINKDATA,U,1) ; payer ien
. S TPAYER=$P($G(^IBE(365.12,PIEN,0)),U,1) ; payer name
. Q
;
I 'PMCNT D G LINKX
. W !!?5,"No insurance companies selected."
. D PAUSE^VALM1
. Q
;
; get confirmation
S DIR(0)="YO"
S DIR("A")="OK to proceed"
S DIR("A",1)="You have selected "_PMCNT_" insurance compan"_$S(PMCNT=1:"y",1:"ies")
S DIR("A",2)="to be linked to payer "_TPAYER_"."
S DIR("B")="YES"
W ! D ^DIR K DIR
I 'Y!$D(DIRUT) G LINKX
;
; At this point, confirmation has been received. Go ahead and do all the links!
;
F PMSUB=0:1 Q:'$D(PMLST(PMSUB)) F PMPCE=1:1 S PMSEL=$P(PMLST(PMSUB),",",PMPCE) Q:PMSEL="" D
. ; this is the loop that makes all the links
. ; with all of the selected insurance companies
. S LINKDATA=$G(^TMP("IBCNEPM",$J,"LINK",+PMSEL))
. I LINKDATA="" Q
. S PIEN=+$P(LINKDATA,U,1)
. S TPAYER=$P($G(^IBE(365.12,PIEN,0)),U,1)
. S INS=+$P(LINKDATA,U,2)
. ;
. ; Make the linkage
. S DA=INS,DIE=36,DR="3.1////"_PIEN D ^DIE
. ;
. ; update the scratch global by removing this insurance company
. KILL ^TMP("IBCNEPM",$J,"PYR",$P(LINKDATA,U,3),PIEN,INS)
. S ^TMP("IBCNEPM",$J,"PYR",$P(LINKDATA,U,3),PIEN)=$G(^TMP("IBCNEPM",$J,"PYR",$P(LINKDATA,U,3),PIEN))-1
. KILL ^TMP("IBCNEPM",$J,"INS",INS,PIEN)
. ;
. ; search scratch global for remaining pointers to this ins. company
. S PIEN="" F S PIEN=$O(^TMP("IBCNEPM",$J,"INS",INS,PIEN)) Q:'PIEN D
.. S TPAYER=$G(^TMP("IBCNEPM",$J,"INS",INS,PIEN))
.. Q:TPAYER=""
.. KILL ^TMP("IBCNEPM",$J,"PYR",TPAYER,PIEN,INS)
.. S ^TMP("IBCNEPM",$J,"PYR",TPAYER,PIEN)=$G(^TMP("IBCNEPM",$J,"PYR",TPAYER,PIEN))-1
.. KILL ^TMP("IBCNEPM",$J,"INS",INS,PIEN)
.. Q
. Q
;
; rebuild the LINK area and the ListMan display global
D INIT
;
; user message
W !!?5,"Link process is complete."
W !?5,"You may view/edit this relationship by using the"
W !?5,"Insurance Company Entry/Edit option."
D PAUSE^VALM1
LINKX ;
S VALMBCK="R"
;
; if there are no more insurance companies for this payer, then quit this 2nd list
; and set a special variable that will rebuild the main, first list
I '$D(^TMP("IBCNEPM",$J,"LINK")) K VALMSG S VALMBCK="Q",IBCNEPRB=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEPM1 5727 printed Apr 09, 2024@21:03:10 Page 2
IBCNEPM1 ;DAOU/ESG - PAYER MAINT/INS COMPANY LIST FOR PAYER ;22-JAN-2003
+1 ;;2.0;INTEGRATED BILLING;**184,416**;21-MAR-94;Build 58
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
EN(IEN,PAYER,PROFID,INSTID) ; -- main entry point for IBCNE PAYER EXPAND LIST
+1 ; IEN is the IEN of the Payer(#365.12). PAYER is the payer's name.
+2 ; PROFID and INSTID are the EDI ID numbers for the selected payer
+3 ; These are passed into this routine from EXPND^IBCNEPM2.
+4 ;
+5 NEW IBCNEPRB
+6 ; call the 2nd list
DO EN^VALM("IBCNE PAYER EXPAND LIST")
+7 ; special variable to rebuild the whole scratch global
IF $GET(IBCNEPRB)
DO INIT^IBCNEPM
GOTO ENX
+8 ; just rebuild the list#1 display
DO BUILD^IBCNEPM
ENX ;
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET VALMHDR(1)="PAYER: "_$EXTRACT(PAYER,1,30)_" Prof. EDI#: "_$EXTRACT($GET(PROFID),1,15)_" Inst. EDI#: "_$EXTRACT($GET(INSTID),1,15)
+2 SET VALMHDR(2)="Insurance Company Name - Active Only"
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 ; Variable PAYER (payer name) is returned by this procedure and used
+2 ; by the list header. Variable LINE is also set before coming into
+3 ; this procedure.
+4 ;
+5 KILL ^TMP("IBCNEPM",$JOB,2),^TMP("IBCNEPM",$JOB,"LINK")
+6 NEW INS,ROW,STRING2,NAME,DATA,ADDRESS,DATA2,PROFID,INSTID
+7 ;
+8 ;IEN is the payer ien (#365.12)
+9 ;PAYER is the payer name
+10 IF IEN=""!(PAYER="")
QUIT
+11 ;
+12 ; INS is the insurance company ien
+13 SET INS=""
SET ROW=0
+14 FOR
SET INS=$ORDER(^TMP("IBCNEPM",$JOB,"PYR",PAYER,IEN,INS))
if INS=""
QUIT
Begin DoDot:1
+15 SET STRING2=""
SET ROW=ROW+1
+16 ; insurance company name
SET NAME=$PIECE($GET(^DIC(36,INS,0)),U,1)
+17 SET DATA=$GET(^DIC(36,INS,.11))
+18 SET ADDRESS=$PIECE(DATA,U,1)
+19 IF $PIECE(DATA,U,4)'=""
SET ADDRESS=ADDRESS_" "_$PIECE(DATA,U,4)
+20 IF $PIECE(DATA,U,5)
SET ADDRESS=ADDRESS_","_$PIECE($GET(^DIC(5,+$PIECE(DATA,U,5),0)),U,2)
+21 SET DATA2=$GET(^DIC(36,INS,3))
+22 SET PROFID=$PIECE(DATA2,U,2)
SET INSTID=$PIECE(DATA2,U,4)
+23 SET STRING2=$$SETFLD^VALM1(NAME,STRING2,"INSURANCE CO")
+24 SET STRING2=$$SETFLD^VALM1(ADDRESS,STRING2,"ADDRESS")
+25 SET STRING2=$$SETFLD^VALM1(ROW,STRING2,"LINE")
+26 SET STRING2=$$SETFLD^VALM1(PROFID,STRING2,"PROFEDI")
+27 SET STRING2=$$SETFLD^VALM1(INSTID,STRING2,"INSTEDI")
+28 DO SET^VALM10(ROW,STRING2)
+29 ;
+30 ; "LINK" scratch global structure = payer ien^ins co ien^payer name
+31 SET ^TMP("IBCNEPM",$JOB,"LINK",ROW)=IEN_U_INS_U_PAYER
+32 QUIT
End DoDot:1
+33 ;
+34 SET VALMCNT=ROW
+35 IF VALMCNT=0
SET VALMSG=" No Matching Insurance Companies "
+36 QUIT
+37 ;
HELP ; -- help code
+1 NEW X
SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
LINK ; -- code to facilitate the linking between the ins company and payer
+1 NEW DIR,X,Y,DIRUT,DIROUT,DTOUT,DUOUT,LINKDATA,PIEN,INS,TPAYER
+2 NEW DA,DIE,DR,D,D0,DI,DIC,DISYS,DQ,%,PMCNT,PMLST,PMPCE,PMSEL,PMSUB
+3 ;
+4 ;PIEN - temp variable for payer IEN (#365.12)
+5 ;TPAYER - temp variable for payer name
+6 ;
+7 DO FULL^VALM1
+8 IF 'VALMCNT
Begin DoDot:1
+9 WRITE !!?5,"There are no insurance companies to select."
+10 DO PAUSE^VALM1
+11 QUIT
End DoDot:1
GOTO LINKX
+12 ;
+13 ; If there is only one ins. company, then assume it's selection and skip the reader
+14 IF VALMCNT=1
SET (Y,Y(0))="1,"
GOTO L1
+15 ;
+16 SET DIR(0)="LO^1:"_VALMCNT_":0"
+17 SET DIR("A")="Select 1 or more Insurance Company Entries"
+18 WRITE !
DO ^DIR
KILL DIR
+19 IF $DATA(DIRUT)
GOTO LINKX
L1 ;
+1 MERGE PMLST=Y
SET PMCNT=0
SET TPAYER=""
+2 FOR PMSUB=0:1
if '$DATA(PMLST(PMSUB))
QUIT
FOR PMPCE=1:1
SET PMSEL=$PIECE(PMLST(PMSUB),",",PMPCE)
if PMSEL=""
QUIT
Begin DoDot:1
+3 ; this is the loop that counts up the numbers selected for display purposes
+4 SET PMCNT=PMCNT+1
+5 IF TPAYER'=""
QUIT
+6 SET LINKDATA=$GET(^TMP("IBCNEPM",$JOB,"LINK",+PMSEL))
IF LINKDATA=""
QUIT
+7 ; payer ien
SET PIEN=+$PIECE(LINKDATA,U,1)
+8 ; payer name
SET TPAYER=$PIECE($GET(^IBE(365.12,PIEN,0)),U,1)
+9 QUIT
End DoDot:1
+10 ;
+11 IF 'PMCNT
Begin DoDot:1
+12 WRITE !!?5,"No insurance companies selected."
+13 DO PAUSE^VALM1
+14 QUIT
End DoDot:1
GOTO LINKX
+15 ;
+16 ; get confirmation
+17 SET DIR(0)="YO"
+18 SET DIR("A")="OK to proceed"
+19 SET DIR("A",1)="You have selected "_PMCNT_" insurance compan"_$SELECT(PMCNT=1:"y",1:"ies")
+20 SET DIR("A",2)="to be linked to payer "_TPAYER_"."
+21 SET DIR("B")="YES"
+22 WRITE !
DO ^DIR
KILL DIR
+23 IF 'Y!$DATA(DIRUT)
GOTO LINKX
+24 ;
+25 ; At this point, confirmation has been received. Go ahead and do all the links!
+26 ;
+27 FOR PMSUB=0:1
if '$DATA(PMLST(PMSUB))
QUIT
FOR PMPCE=1:1
SET PMSEL=$PIECE(PMLST(PMSUB),",",PMPCE)
if PMSEL=""
QUIT
Begin DoDot:1
+28 ; this is the loop that makes all the links
+29 ; with all of the selected insurance companies
+30 SET LINKDATA=$GET(^TMP("IBCNEPM",$JOB,"LINK",+PMSEL))
+31 IF LINKDATA=""
QUIT
+32 SET PIEN=+$PIECE(LINKDATA,U,1)
+33 SET TPAYER=$PIECE($GET(^IBE(365.12,PIEN,0)),U,1)
+34 SET INS=+$PIECE(LINKDATA,U,2)
+35 ;
+36 ; Make the linkage
+37 SET DA=INS
SET DIE=36
SET DR="3.1////"_PIEN
DO ^DIE
+38 ;
+39 ; update the scratch global by removing this insurance company
+40 KILL ^TMP("IBCNEPM",$JOB,"PYR",$PIECE(LINKDATA,U,3),PIEN,INS)
+41 SET ^TMP("IBCNEPM",$JOB,"PYR",$PIECE(LINKDATA,U,3),PIEN)=$GET(^TMP("IBCNEPM",$JOB,"PYR",$PIECE(LINKDATA,U,3),PIEN))-1
+42 KILL ^TMP("IBCNEPM",$JOB,"INS",INS,PIEN)
+43 ;
+44 ; search scratch global for remaining pointers to this ins. company
+45 SET PIEN=""
FOR
SET PIEN=$ORDER(^TMP("IBCNEPM",$JOB,"INS",INS,PIEN))
if 'PIEN
QUIT
Begin DoDot:2
+46 SET TPAYER=$GET(^TMP("IBCNEPM",$JOB,"INS",INS,PIEN))
+47 if TPAYER=""
QUIT
+48 KILL ^TMP("IBCNEPM",$JOB,"PYR",TPAYER,PIEN,INS)
+49 SET ^TMP("IBCNEPM",$JOB,"PYR",TPAYER,PIEN)=$GET(^TMP("IBCNEPM",$JOB,"PYR",TPAYER,PIEN))-1
+50 KILL ^TMP("IBCNEPM",$JOB,"INS",INS,PIEN)
+51 QUIT
End DoDot:2
+52 QUIT
End DoDot:1
+53 ;
+54 ; rebuild the LINK area and the ListMan display global
+55 DO INIT
+56 ;
+57 ; user message
+58 WRITE !!?5,"Link process is complete."
+59 WRITE !?5,"You may view/edit this relationship by using the"
+60 WRITE !?5,"Insurance Company Entry/Edit option."
+61 DO PAUSE^VALM1
LINKX ;
+1 SET VALMBCK="R"
+2 ;
+3 ; if there are no more insurance companies for this payer, then quit this 2nd list
+4 ; and set a special variable that will rebuild the main, first list
+5 IF '$DATA(^TMP("IBCNEPM",$JOB,"LINK"))
KILL VALMSG
SET VALMBCK="Q"
SET IBCNEPRB=1
+6 QUIT
+7 ;
