| 1 | IBCNEPM1 ;DAOU/ESG - PAYER MAINT/INS COMPANY LIST FOR PAYER ;22-JAN-2003
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**184**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN(IEN,PAYER,PROFID,INSTID) ; -- main entry point for IBCNE PAYER EXPAND LIST
|
|---|
| 6 | ; IEN is the IEN of the Payer(#365.15). PAYER is the payer's name.
|
|---|
| 7 | ; PROFID and INSTID are the EDI ID numbers for the selected payer
|
|---|
| 8 | ; These are passed into this routine from EXPND^IBCNEPM2.
|
|---|
| 9 | ;
|
|---|
| 10 | D EN^VALM("IBCNE PAYER EXPAND LIST")
|
|---|
| 11 | D BUILD^IBCNEPM
|
|---|
| 12 | S VALMBCK="R"
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | HDR ; -- header code
|
|---|
| 16 | S VALMHDR(1)="PAYER: "_$E(PAYER,1,30)_" Prof. EDI#:"_$E($G(PROFID),1,15)_" Inst. EDI#:"_$E($G(INSTID),1,15)
|
|---|
| 17 | S VALMHDR(2)="Insurance Company Name - Active Only"
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | INIT ; -- init variables and list array
|
|---|
| 21 | ; Variable PAYER (payer name) is returned by this procedure and used
|
|---|
| 22 | ; by the list header. Variable LINE is also set before coming into
|
|---|
| 23 | ; this procedure.
|
|---|
| 24 | ;
|
|---|
| 25 | KILL ^TMP("IBCNEPM",$J,2),^TMP("IBCNEPM",$J,"LINK")
|
|---|
| 26 | NEW INS,ROW,STRING2,NAME,DATA,ADDRESS,DATA2,PROFID,INSTID
|
|---|
| 27 | ;
|
|---|
| 28 | ;IEN is the payer ien (#365.15)
|
|---|
| 29 | ;PAYER is the payer name
|
|---|
| 30 | I IEN=""!(PAYER="") Q
|
|---|
| 31 | ;
|
|---|
| 32 | ; INS is the insurance company ien
|
|---|
| 33 | S INS="",ROW=0
|
|---|
| 34 | F S INS=$O(^TMP("IBCNEPM",$J,"PYR",PAYER,IEN,INS)) Q:INS="" D
|
|---|
| 35 | . S STRING2="",ROW=ROW+1
|
|---|
| 36 | . S NAME=$P($G(^DIC(36,INS,0)),U) ; insurance company name
|
|---|
| 37 | . S DATA=$G(^DIC(36,INS,.11))
|
|---|
| 38 | . S ADDRESS=$P(DATA,U)_" "_$P(DATA,U,4)
|
|---|
| 39 | . I $P(DATA,U,4)'="" S ADDRESS=ADDRESS_","
|
|---|
| 40 | . S ADDRESS=ADDRESS_" "_$P($G(^DIC(5,+$P(DATA,U,5),0)),U,2)
|
|---|
| 41 | . S DATA2=$G(^DIC(36,INS,3))
|
|---|
| 42 | . S PROFID=$P(DATA2,U,2),INSTID=$P(DATA2,U,4)
|
|---|
| 43 | . S STRING2=$$SETFLD^VALM1(NAME,STRING2,"INSURANCE CO")
|
|---|
| 44 | . S STRING2=$$SETFLD^VALM1(ADDRESS,STRING2,"ADDRESS")
|
|---|
| 45 | . S STRING2=$$SETFLD^VALM1(ROW,STRING2,"LINE")
|
|---|
| 46 | . S STRING2=$$SETFLD^VALM1(PROFID,STRING2,"PROFEDI")
|
|---|
| 47 | . S STRING2=$$SETFLD^VALM1(INSTID,STRING2,"INSTEDI")
|
|---|
| 48 | . D SET^VALM10(ROW,STRING2)
|
|---|
| 49 | . ;
|
|---|
| 50 | . ; "LINK" scratch global structure = payer ien^ins co ien^payer name
|
|---|
| 51 | . S ^TMP("IBCNEPM",$J,"LINK",ROW)=IEN_U_INS_U_PAYER
|
|---|
| 52 | . Q
|
|---|
| 53 | ;
|
|---|
| 54 | S VALMCNT=ROW
|
|---|
| 55 | I VALMCNT=0 S VALMSG=" No Matching Insurance Companies "
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | HELP ; -- help code
|
|---|
| 59 | N X S X="?" D DISP^XQORM1 W !!
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | EXIT ; -- exit code
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | LINK ; -- code to facilitate the linking between the ins company and payer
|
|---|
| 66 | NEW DIR,X,Y,DIRUT,DIROUT,DTOUT,DUOUT,LINKDATA,PIEN,INS,TPAYER,INSNM
|
|---|
| 67 | NEW DA,DIE,DR,D,D0,DI,DIC,DISYS,DQ,%
|
|---|
| 68 | ;
|
|---|
| 69 | ;PIEN - temp variable for payer IEN (#365.15)
|
|---|
| 70 | ;TPAYER - temp variable for payer name
|
|---|
| 71 | ;
|
|---|
| 72 | D FULL^VALM1
|
|---|
| 73 | I 'VALMCNT D G LINKX
|
|---|
| 74 | . W !!?5,"There are no insurance companies to select."
|
|---|
| 75 | . D PAUSE^VALM1
|
|---|
| 76 | . Q
|
|---|
| 77 | ;
|
|---|
| 78 | S DIR(0)="NO^1:"_VALMCNT_":0"
|
|---|
| 79 | S DIR("A")="Select Insurance Company Entry"
|
|---|
| 80 | W !
|
|---|
| 81 | D ^DIR K DIR
|
|---|
| 82 | I 'Y G LINKX
|
|---|
| 83 | S LINKDATA=$G(^TMP("IBCNEPM",$J,"LINK",+Y))
|
|---|
| 84 | I LINKDATA="" G LINKX
|
|---|
| 85 | S PIEN=+$P(LINKDATA,U,1),TPAYER=$P($G(^IBE(365.12,PIEN,0)),U,1)
|
|---|
| 86 | S INS=+$P(LINKDATA,U,2),INSNM=$P($G(^DIC(36,INS,0)),U,1)
|
|---|
| 87 | W !!," Payer: ",TPAYER
|
|---|
| 88 | W !," Insurance Company: ",INSNM
|
|---|
| 89 | W !
|
|---|
| 90 | S DIR(0)="YO"
|
|---|
| 91 | S DIR("A")=" Do you want to link this insurance company to this payer"
|
|---|
| 92 | S DIR("B")="YES"
|
|---|
| 93 | D ^DIR K DIR
|
|---|
| 94 | I 'Y G LINKX
|
|---|
| 95 | ;
|
|---|
| 96 | ; At this point we know that we should make the linkage
|
|---|
| 97 | S DA=INS,DIE=36,DR="3.1////"_PIEN D ^DIE
|
|---|
| 98 | ;
|
|---|
| 99 | ; update the scratch global by removing this insurance company
|
|---|
| 100 | KILL ^TMP("IBCNEPM",$J,"PYR",$P(LINKDATA,U,3),PIEN,INS)
|
|---|
| 101 | S ^TMP("IBCNEPM",$J,"PYR",$P(LINKDATA,U,3),PIEN)=$G(^TMP("IBCNEPM",$J,"PYR",$P(LINKDATA,U,3),PIEN))-1
|
|---|
| 102 | KILL ^TMP("IBCNEPM",$J,"INS",INS,PIEN)
|
|---|
| 103 | ;
|
|---|
| 104 | ; search scratch global for remaining pointers to this ins. company
|
|---|
| 105 | S PIEN="" F S PIEN=$O(^TMP("IBCNEPM",$J,"INS",INS,PIEN)) Q:'PIEN D
|
|---|
| 106 | . S TPAYER=$G(^TMP("IBCNEPM",$J,"INS",INS,PIEN))
|
|---|
| 107 | . Q:TPAYER=""
|
|---|
| 108 | . KILL ^TMP("IBCNEPM",$J,"PYR",TPAYER,PIEN,INS)
|
|---|
| 109 | . S ^TMP("IBCNEPM",$J,"PYR",TPAYER,PIEN)=$G(^TMP("IBCNEPM",$J,"PYR",TPAYER,PIEN))-1
|
|---|
| 110 | . KILL ^TMP("IBCNEPM",$J,"INS",INS,PIEN)
|
|---|
| 111 | ;
|
|---|
| 112 | ; rebuild the LINK area and the ListMan display global
|
|---|
| 113 | D INIT
|
|---|
| 114 | ;
|
|---|
| 115 | ; user message
|
|---|
| 116 | W !!?5,"They are now linked. You may view/edit this relationship by using the"
|
|---|
| 117 | W !?5,"Insurance Company Entry/Edit option."
|
|---|
| 118 | D PAUSE^VALM1
|
|---|
| 119 | LINKX ;
|
|---|
| 120 | S VALMBCK="R"
|
|---|
| 121 | Q
|
|---|
| 122 | ;
|
|---|
