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

IBCNSGM.m

Go to the documentation of this file. 
  1. IBCNSGM ;ALB/ESG - Insurance Company Billing Provider Flag Rpt/Msg ;06-APR-2009
  1.  ;;2.0;INTEGRATED BILLING;**400,516**;21-MAR-94;Build 123
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. EN ; entry point also from the top
  1.  I '$$PROD^XUPROD(1) G EX     ; production account only
  1.  D COMPILE
  1.  D EMAIL
  1. EX ;
  1.  Q
  1.  ;
  1. COMPILE ; Build a sorted scratch global of payers in switchback mode
  1.  N IEN,Z,FLGP,FLGI,DATA,ADDR,EDI,PROFID,INSTID,NAME,STREET,CITY,STATE,TRANS,SWBCK,TMP
  1.  K ^TMP($J,"IBCNSGM")
  1.  S IEN=0 F  S IEN=$O(^DIC(36,IEN)) Q:'IEN  D
  1.  . I '$$ACTIVE^IBCNEUT4(IEN) Q     ; skip inactive insurance companies
  1.  . S Z=$G(^DIC(36,IEN,4))
  1.  . S FLGP=+$P(Z,U,11)              ; prof switchback flag
  1.  . S FLGI=+$P(Z,U,12)              ; inst switchback flag
  1.  . I 'FLGP,'FLGI Q                 ; both switchback flags are off
  1.  . S DATA=$G(^DIC(36,IEN,0))
  1.  . S ADDR=$G(^DIC(36,IEN,.11))
  1.  . S EDI=$G(^DIC(36,IEN,3))
  1.  . S PROFID=$P(EDI,U,2)
  1.  . S INSTID=$P(EDI,U,4)
  1.  . S NAME=$P(DATA,U,1) S:NAME="" NAME="~UNK"
  1.  . S STREET=$P(ADDR,U,1)
  1.  . S CITY=$P(ADDR,U,4)
  1.  . S STATE=+$P(ADDR,U,5)
  1.  . S STATE=$S(STATE:$P($G(^DIC(5,STATE,0)),U,2),1:"")
  1.  . S TRANS=$$EXTERNAL^DILFD(36,3.01,,$P(EDI,U,1))
  1.  . S SWBCK=""
  1.  . I FLGP,FLGI S SWBCK="BOTH"
  1.  . I FLGP,'FLGI S SWBCK="PROF"
  1.  . I 'FLGP,FLGI S SWBCK="INST"
  1.  . ;
  1.  . S TMP=STREET_U_CITY_U_STATE_U_SWBCK_U_TRANS_U_INSTID_U_PROFID
  1.  . S ^TMP($J,"IBCNSGM",1,NAME,IEN)=TMP
  1.  . S ^TMP($J,"IBCNSGM",1)=$G(^TMP($J,"IBCNSGM",1))+1
  1.  . Q
  1. COMPX ;
  1.  Q
  1.  ;
  1. EMAIL ; Construct the subject and text of the message and send it
  1.  N MSG,LN,SITE,ZNP,XMSUBJ,XMTO,NM,IEN,TMP,DISP,CITY,SUBJ,GLO,GLB,KEY,IBX,XMINSTR
  1.  S SITE=$$SITE^VASITE
  1.  S ZNP=+$G(^TMP($J,"IBCNSGM",1))
  1.  S XMSUBJ="Switchback Mode - "_$P(SITE,U,3)_" - "_ZNP_" Payer"_$S(ZNP=1:"",1:"s")_" - "_$P(SITE,U,2)
  1.  S XMSUBJ=$E(XMSUBJ,1,65)
  1.  S MSG=$NA(^TMP($J,"IBCNSGM",2))
  1.  K @MSG
  1.  S LN=0
  1.  S LN=LN+1,@MSG@(LN)="This report shows VistA insurance companies which are in IB patch 400 switchback mode for the following site."
  1.  S LN=LN+1,@MSG@(LN)=""
  1.  S LN=LN+1,@MSG@(LN)="        Name: "_$P(SITE,U,2)
  1.  S LN=LN+1,@MSG@(LN)="    Station#: "_$P(SITE,U,3)
  1.  S LN=LN+1,@MSG@(LN)="      Domain: "_$G(^XMB("NETNAME"))
  1.  S LN=LN+1,@MSG@(LN)="   Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT,"5ZPM")
  1.  S LN=LN+1,@MSG@(LN)=""
  1.  S LN=LN+1,@MSG@(LN)=""
  1.  S LN=LN+1,@MSG@(LN)="Insurance                Street                                Switch  Electron  Inst     Prof"
  1.  S LN=LN+1,@MSG@(LN)="Company Name             Address            City                Back   Transmit   ID       ID"
  1.  S LN=LN+1,@MSG@(LN)="---------------------------------------------------------------------------------------------------"
  1.  ;
  1.  S NM="" F  S NM=$O(^TMP($J,"IBCNSGM",1,NM)) Q:NM=""  S IEN=0 F  S IEN=$O(^TMP($J,"IBCNSGM",1,NM,IEN)) Q:'IEN  D
  1.  . S TMP=$G(^TMP($J,"IBCNSGM",1,NM,IEN))
  1.  . S DISP=$$FO^IBCNEUT1(NM,24)_" "                       ; ins co name
  1.  . S DISP=DISP_$$FO^IBCNEUT1($P(TMP,U,1),18)_" "         ; street address
  1.  . S CITY=$E($P(TMP,U,2),1,16)
  1.  . I CITY'="",$P(TMP,U,3)'="" S CITY=CITY_","
  1.  . S CITY=CITY_$P(TMP,U,3)
  1.  . S DISP=DISP_$$FO^IBCNEUT1(CITY,19)_" "                ; city, state
  1.  . S DISP=DISP_$$FO^IBCNEUT1($P(TMP,U,4),4)_"   "        ; switchback flag value
  1.  . S DISP=DISP_$$FO^IBCNEUT1($P(TMP,U,5),8)_"  "         ; electronic transmit flag
  1.  . S DISP=DISP_$$FO^IBCNEUT1($P(TMP,U,6),8)_" "          ; inst payer ID
  1.  . S DISP=DISP_$$FO^IBCNEUT1($P(TMP,U,7),8)              ; prof payer ID
  1.  . S LN=LN+1,@MSG@(LN)=DISP
  1.  . Q
  1.  ;
  1.  I 'ZNP D
  1.  . S LN=LN+1,@MSG@(LN)=""
  1.  . S LN=LN+1,@MSG@(LN)="        No Data Found"
  1.  . Q
  1.  ;
  1.  S LN=LN+1,@MSG@(LN)=""
  1.  S LN=LN+1,@MSG@(LN)="Total number of companies in switchback mode: "_ZNP
  1.  S LN=LN+1,@MSG@(LN)=""
  1.  S LN=LN+1,@MSG@(LN)="*** End of Report ***"
  1.  ;
  1.  ; display taskman schedule information for server request
  1.  I $G(IBSNDRSQ)'="" D
  1.  . N OPTNM,IBZ,T
  1.  . S OPTNM="IBCN INS BILL PROV FLAG RPT"
  1.  . D OPTSTAT^XUTMOPT(OPTNM,.IBZ)
  1.  . S T=$G(IBZ(1))
  1.  . S LN=LN+1,@MSG@(LN)=""
  1.  . S LN=LN+1,@MSG@(LN)=""
  1.  . S LN=LN+1,@MSG@(LN)="TaskManager Schedule Report for server request"
  1.  . S LN=LN+1,@MSG@(LN)="----------------------------------------------"
  1.  . S LN=LN+1,@MSG@(LN)="           Option: "_OPTNM
  1.  . S LN=LN+1,@MSG@(LN)="      Task Number: "_$P(T,U,1)
  1.  . S LN=LN+1,@MSG@(LN)="    Queued to Run: "_$$FMTE^XLFDT($P(T,U,2),"5ZPM")
  1.  . S LN=LN+1,@MSG@(LN)="Rescheduling Freq: "_$P(T,U,3)
  1.  . Q
  1.  ;
  1.  ; Address the message
  1.  I $G(IBSNDRSQ)="" S XMTO("vhacoebilpm@domain.ext")=""
  1.  I $G(IBSNDRSQ)'="" S XMTO(IBSNDRSQ)=""
  1.  ;
  1.  S XMINSTR("FROM")="VistA-eBilling"
  1.  ;
  1.  D SENDMSG^XMXAPI(DUZ,XMSUBJ,MSG,.XMTO,.XMINSTR)
  1.  K ^TMP($J,"IBCNSGM")                ; clean-up scratch global
  1.  I '$D(^TMP("XMERR",$J)) G EMAILX    ; no email problems so get out
  1.  ;
  1.  S SUBJ="IB*2*400 - MailMan Error - Ins Co Billing Provider Flag Rpt/Msg"
  1.  K MSG S LN=0
  1.  S LN=LN+1,MSG(LN)="MailMan reported the following error(s) when attempting to send the"
  1.  S LN=LN+1,MSG(LN)="Insurance Company Billing Provider Flag Report."
  1.  S LN=LN+1,MSG(LN)=""
  1.  S (GLO,GLB)="^TMP(""XMERR"","_$J
  1.  S GLO=GLO_")"
  1.  F  S GLO=$Q(@GLO) Q:GLO'[GLB  S LN=LN+1,MSG(LN)="   "_GLO_" = "_$G(@GLO)
  1.  S LN=LN+1,MSG(LN)=""
  1.  S LN=LN+1,MSG(LN)="This report should be automatically run on a regular schedule through"
  1.  S LN=LN+1,MSG(LN)="TaskManager.  The VistA option name is IBCN INS BILL PROV FLAG RPT."
  1.  S LN=LN+1,MSG(LN)=""
  1.  S LN=LN+1,MSG(LN)="Please correct the MailMan problem and re-run this report.  If you"
  1.  S LN=LN+1,MSG(LN)="need help, please enter a Remedy ticket or call the help desk at"
  1.  S LN=LN+1,MSG(LN)="1-888-596-4357."
  1.  ;
  1.  K XMTO,XMINSTR
  1.  S XMTO(DUZ)=""
  1.  S XMINSTR("FROM")="VistA routine IBCNSGM"
  1.  ;
  1.  ; send this local msg to holders of these security keys so they can fix the problems (IA# 10076)
  1.  F KEY="XUMGR","XUPROG" S IBX=0 F  S IBX=$O(^XUSEC(KEY,IBX)) Q:'IBX  S XMTO(IBX)=""
  1.  D SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO,.XMINSTR)
  1.  K MSG
  1.  ;
  1. EMAILX ;
  1.  Q
  1.  ;
  1. SRV ; server entry point
  1.  ; send the report and the TaskManager schedule at the site back to the sender of the server request
  1.  ;IB*2.0*516/TAZ - This is an inbound server request. It cannot be removed.
  1.  G SRVX
  1.  N MMHD,IBSNDRSQ
  1.  I '$G(XMZ) G SRVX                      ; only for processing incoming server requests
  1.  S MMHD=$$NET^XMRENT(XMZ)               ; mailman header information
  1.  S IBSNDRSQ=$TR($P(MMHD,U,3),"<>")      ; sender of server request
  1.  D EN                                   ; send message
  1.  D ZAPSERV^XMXAPI("S.IBCNSRVBP",XMZ)    ; delete msg from server basket
  1. SRVX ;
  1.  Q
  1.  ;