Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNEPM1

IBCNEPM1.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. 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.
  1.  ; PROFID and INSTID are the EDI ID numbers for the selected payer
  1.  ; These are passed into this routine from EXPND^IBCNEPM2.
  1.  ;
  1.  N IBCNEPRB
  1.  D EN^VALM("IBCNE PAYER EXPAND LIST")    ; call the 2nd list
  1.  I $G(IBCNEPRB) D INIT^IBCNEPM G ENX     ; special variable to rebuild the whole scratch global
  1.  D BUILD^IBCNEPM                         ; just rebuild the list#1 display
  1. ENX ;
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  S VALMHDR(1)="PAYER: "_$E(PAYER,1,30)_"     Prof. EDI#: "_$E($G(PROFID),1,15)_"  Inst. EDI#: "_$E($G(INSTID),1,15)
  1.  S VALMHDR(2)="Insurance Company Name - Active Only"
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  ; Variable PAYER (payer name) is returned by this procedure and used 
  1.  ; by the list header.  Variable LINE is also set before coming into 
  1.  ; this procedure.
  1.  ;
  1.  KILL ^TMP("IBCNEPM",$J,2),^TMP("IBCNEPM",$J,"LINK")
  1.  NEW INS,ROW,STRING2,NAME,DATA,ADDRESS,DATA2,PROFID,INSTID
  1.  ;
  1.  ;IEN is the payer ien (#365.12)
  1.  ;PAYER is the payer name
  1.  I IEN=""!(PAYER="") Q
  1.  ;
  1.  ; INS is the insurance company ien
  1.  S INS="",ROW=0
  1.  F  S INS=$O(^TMP("IBCNEPM",$J,"PYR",PAYER,IEN,INS)) Q:INS=""  D
  1.  . S STRING2="",ROW=ROW+1
  1.  . S NAME=$P($G(^DIC(36,INS,0)),U,1)   ; insurance company name
  1.  . S DATA=$G(^DIC(36,INS,.11))
  1.  . S ADDRESS=$P(DATA,U,1)
  1.  . I $P(DATA,U,4)'="" S ADDRESS=ADDRESS_"  "_$P(DATA,U,4)
  1.  . I $P(DATA,U,5) S ADDRESS=ADDRESS_","_$P($G(^DIC(5,+$P(DATA,U,5),0)),U,2)
  1.  . S DATA2=$G(^DIC(36,INS,3))
  1.  . S PROFID=$P(DATA2,U,2),INSTID=$P(DATA2,U,4)
  1.  . S STRING2=$$SETFLD^VALM1(NAME,STRING2,"INSURANCE CO")
  1.  . S STRING2=$$SETFLD^VALM1(ADDRESS,STRING2,"ADDRESS")
  1.  . S STRING2=$$SETFLD^VALM1(ROW,STRING2,"LINE")
  1.  . S STRING2=$$SETFLD^VALM1(PROFID,STRING2,"PROFEDI")
  1.  . S STRING2=$$SETFLD^VALM1(INSTID,STRING2,"INSTEDI")
  1.  . D SET^VALM10(ROW,STRING2)
  1.  . ;
  1.  . ; "LINK" scratch global structure = payer ien^ins co ien^payer name
  1.  . S ^TMP("IBCNEPM",$J,"LINK",ROW)=IEN_U_INS_U_PAYER
  1.  . Q
  1.  ;
  1.  S VALMCNT=ROW
  1.  I VALMCNT=0 S VALMSG=" No Matching Insurance Companies "
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  N X S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  Q
  1.  ;
  1.  NEW DIR,X,Y,DIRUT,DIROUT,DTOUT,DUOUT,LINKDATA,PIEN,INS,TPAYER
  1.  NEW DA,DIE,DR,D,D0,DI,DIC,DISYS,DQ,%,PMCNT,PMLST,PMPCE,PMSEL,PMSUB
  1.  ;
  1.  ;PIEN - temp variable for payer IEN (#365.12)
  1.  ;TPAYER - temp variable for payer name
  1.  ;
  1.  D FULL^VALM1
  1.  I 'VALMCNT D  G LINKX
  1.  . W !!?5,"There are no insurance companies to select."
  1.  . D PAUSE^VALM1
  1.  . Q
  1.  ;
  1.  ; If there is only one ins. company, then assume it's selection and skip the reader
  1.  I VALMCNT=1 S (Y,Y(0))="1," G L1
  1.  ;
  1.  S DIR(0)="LO^1:"_VALMCNT_":0"
  1.  S DIR("A")="Select 1 or more Insurance Company Entries"
  1.  W ! D ^DIR K DIR
  1.  I $D(DIRUT) G LINKX
  1. L1 ;
  1.  M PMLST=Y S PMCNT=0,TPAYER=""
  1.  F PMSUB=0:1 Q:'$D(PMLST(PMSUB))  F PMPCE=1:1 S PMSEL=$P(PMLST(PMSUB),",",PMPCE) Q:PMSEL=""  D
  1.  . ; this is the loop that counts up the numbers selected for display purposes
  1.  . S PMCNT=PMCNT+1
  1.  . I TPAYER'="" Q
  1.  . S LINKDATA=$G(^TMP("IBCNEPM",$J,"LINK",+PMSEL)) I LINKDATA="" Q
  1.  . S PIEN=+$P(LINKDATA,U,1)                   ; payer ien
  1.  . S TPAYER=$P($G(^IBE(365.12,PIEN,0)),U,1)   ; payer name
  1.  . Q
  1.  ;
  1.  I 'PMCNT D  G LINKX
  1.  . W !!?5,"No insurance companies selected."
  1.  . D PAUSE^VALM1
  1.  . Q
  1.  ;
  1.  ; get confirmation
  1.  S DIR(0)="YO"
  1.  S DIR("A")="OK to proceed"
  1.  S DIR("A",1)="You have selected "_PMCNT_" insurance compan"_$S(PMCNT=1:"y",1:"ies")
  1.  S DIR("A",2)="to be linked to payer "_TPAYER_"."
  1.  S DIR("B")="YES"
  1.  W ! D ^DIR K DIR
  1.  I 'Y!$D(DIRUT) G LINKX
  1.  ;
  1.  ; At this point, confirmation has been received.   Go ahead and do all the links!
  1.  ;
  1.  F PMSUB=0:1 Q:'$D(PMLST(PMSUB))  F PMPCE=1:1 S PMSEL=$P(PMLST(PMSUB),",",PMPCE) Q:PMSEL=""  D
  1.  . ; this is the loop that makes all the links
  1.  . ; with all of the selected insurance companies
  1.  . S LINKDATA=$G(^TMP("IBCNEPM",$J,"LINK",+PMSEL))
  1.  . I LINKDATA="" Q
  1.  . S PIEN=+$P(LINKDATA,U,1)
  1.  . S TPAYER=$P($G(^IBE(365.12,PIEN,0)),U,1)
  1.  . S INS=+$P(LINKDATA,U,2)
  1.  . ;
  1.  . ; Make the linkage
  1.  . S DA=INS,DIE=36,DR="3.1////"_PIEN D ^DIE
  1.  . ;
  1.  . ; update the scratch global by removing this insurance company
  1.  . KILL ^TMP("IBCNEPM",$J,"PYR",$P(LINKDATA,U,3),PIEN,INS)
  1.  . S ^TMP("IBCNEPM",$J,"PYR",$P(LINKDATA,U,3),PIEN)=$G(^TMP("IBCNEPM",$J,"PYR",$P(LINKDATA,U,3),PIEN))-1
  1.  . KILL ^TMP("IBCNEPM",$J,"INS",INS,PIEN)
  1.  . ;
  1.  . ; search scratch global for remaining pointers to this ins. company
  1.  . S PIEN="" F  S PIEN=$O(^TMP("IBCNEPM",$J,"INS",INS,PIEN)) Q:'PIEN  D
  1.  .. S TPAYER=$G(^TMP("IBCNEPM",$J,"INS",INS,PIEN))
  1.  .. Q:TPAYER=""
  1.  .. KILL ^TMP("IBCNEPM",$J,"PYR",TPAYER,PIEN,INS)
  1.  .. S ^TMP("IBCNEPM",$J,"PYR",TPAYER,PIEN)=$G(^TMP("IBCNEPM",$J,"PYR",TPAYER,PIEN))-1
  1.  .. KILL ^TMP("IBCNEPM",$J,"INS",INS,PIEN)
  1.  .. Q
  1.  . Q
  1.  ;
  1.  ; rebuild the LINK area and the ListMan display global
  1.  D INIT
  1.  ;
  1.  ; user message
  1.  W !!?5,"Link process is complete."
  1.  W !?5,"You may view/edit this relationship by using the"
  1.  W !?5,"Insurance Company Entry/Edit option."
  1.  D PAUSE^VALM1
  1. LINKX ;
  1.  S VALMBCK="R"
  1.  ;
  1.  ; if there are no more insurance companies for this payer, then quit this 2nd list
  1.  ; and set a special variable that will rebuild the main, first list
  1.  I '$D(^TMP("IBCNEPM",$J,"LINK")) K VALMSG S VALMBCK="Q",IBCNEPRB=1
  1.  Q
  1.  ;