IBCNSGM ;ALB/ESG - Insurance Company Billing Provider Flag Rpt/Msg ;06-APR-2009
;;2.0;INTEGRATED BILLING;**400,516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; entry point also from the top
I '$$PROD^XUPROD(1) G EX ; production account only
D COMPILE
D EMAIL
EX ;
Q
;
COMPILE ; Build a sorted scratch global of payers in switchback mode
N IEN,Z,FLGP,FLGI,DATA,ADDR,EDI,PROFID,INSTID,NAME,STREET,CITY,STATE,TRANS,SWBCK,TMP
K ^TMP($J,"IBCNSGM")
S IEN=0 F S IEN=$O(^DIC(36,IEN)) Q:'IEN D
. I '$$ACTIVE^IBCNEUT4(IEN) Q ; skip inactive insurance companies
. S Z=$G(^DIC(36,IEN,4))
. S FLGP=+$P(Z,U,11) ; prof switchback flag
. S FLGI=+$P(Z,U,12) ; inst switchback flag
. I 'FLGP,'FLGI Q ; both switchback flags are off
. S DATA=$G(^DIC(36,IEN,0))
. S ADDR=$G(^DIC(36,IEN,.11))
. S EDI=$G(^DIC(36,IEN,3))
. S PROFID=$P(EDI,U,2)
. S INSTID=$P(EDI,U,4)
. S NAME=$P(DATA,U,1) S:NAME="" NAME="~UNK"
. S STREET=$P(ADDR,U,1)
. S CITY=$P(ADDR,U,4)
. S STATE=+$P(ADDR,U,5)
. S STATE=$S(STATE:$P($G(^DIC(5,STATE,0)),U,2),1:"")
. S TRANS=$$EXTERNAL^DILFD(36,3.01,,$P(EDI,U,1))
. S SWBCK=""
. I FLGP,FLGI S SWBCK="BOTH"
. I FLGP,'FLGI S SWBCK="PROF"
. I 'FLGP,FLGI S SWBCK="INST"
. ;
. S TMP=STREET_U_CITY_U_STATE_U_SWBCK_U_TRANS_U_INSTID_U_PROFID
. S ^TMP($J,"IBCNSGM",1,NAME,IEN)=TMP
. S ^TMP($J,"IBCNSGM",1)=$G(^TMP($J,"IBCNSGM",1))+1
. Q
COMPX ;
Q
;
EMAIL ; Construct the subject and text of the message and send it
N MSG,LN,SITE,ZNP,XMSUBJ,XMTO,NM,IEN,TMP,DISP,CITY,SUBJ,GLO,GLB,KEY,IBX,XMINSTR
S SITE=$$SITE^VASITE
S ZNP=+$G(^TMP($J,"IBCNSGM",1))
S XMSUBJ="Switchback Mode - "_$P(SITE,U,3)_" - "_ZNP_" Payer"_$S(ZNP=1:"",1:"s")_" - "_$P(SITE,U,2)
S XMSUBJ=$E(XMSUBJ,1,65)
S MSG=$NA(^TMP($J,"IBCNSGM",2))
K @MSG
S LN=0
S LN=LN+1,@MSG@(LN)="This report shows VistA insurance companies which are in IB patch 400 switchback mode for the following site."
S LN=LN+1,@MSG@(LN)=""
S LN=LN+1,@MSG@(LN)=" Name: "_$P(SITE,U,2)
S LN=LN+1,@MSG@(LN)=" Station#: "_$P(SITE,U,3)
S LN=LN+1,@MSG@(LN)=" Domain: "_$G(^XMB("NETNAME"))
S LN=LN+1,@MSG@(LN)=" Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT,"5ZPM")
S LN=LN+1,@MSG@(LN)=""
S LN=LN+1,@MSG@(LN)=""
S LN=LN+1,@MSG@(LN)="Insurance Street Switch Electron Inst Prof"
S LN=LN+1,@MSG@(LN)="Company Name Address City Back Transmit ID ID"
S LN=LN+1,@MSG@(LN)="---------------------------------------------------------------------------------------------------"
;
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
. S TMP=$G(^TMP($J,"IBCNSGM",1,NM,IEN))
. S DISP=$$FO^IBCNEUT1(NM,24)_" " ; ins co name
. S DISP=DISP_$$FO^IBCNEUT1($P(TMP,U,1),18)_" " ; street address
. S CITY=$E($P(TMP,U,2),1,16)
. I CITY'="",$P(TMP,U,3)'="" S CITY=CITY_","
. S CITY=CITY_$P(TMP,U,3)
. S DISP=DISP_$$FO^IBCNEUT1(CITY,19)_" " ; city, state
. S DISP=DISP_$$FO^IBCNEUT1($P(TMP,U,4),4)_" " ; switchback flag value
. S DISP=DISP_$$FO^IBCNEUT1($P(TMP,U,5),8)_" " ; electronic transmit flag
. S DISP=DISP_$$FO^IBCNEUT1($P(TMP,U,6),8)_" " ; inst payer ID
. S DISP=DISP_$$FO^IBCNEUT1($P(TMP,U,7),8) ; prof payer ID
. S LN=LN+1,@MSG@(LN)=DISP
. Q
;
I 'ZNP D
. S LN=LN+1,@MSG@(LN)=""
. S LN=LN+1,@MSG@(LN)=" No Data Found"
. Q
;
S LN=LN+1,@MSG@(LN)=""
S LN=LN+1,@MSG@(LN)="Total number of companies in switchback mode: "_ZNP
S LN=LN+1,@MSG@(LN)=""
S LN=LN+1,@MSG@(LN)="*** End of Report ***"
;
; display taskman schedule information for server request
I $G(IBSNDRSQ)'="" D
. N OPTNM,IBZ,T
. S OPTNM="IBCN INS BILL PROV FLAG RPT"
. D OPTSTAT^XUTMOPT(OPTNM,.IBZ)
. S T=$G(IBZ(1))
. S LN=LN+1,@MSG@(LN)=""
. S LN=LN+1,@MSG@(LN)=""
. S LN=LN+1,@MSG@(LN)="TaskManager Schedule Report for server request"
. S LN=LN+1,@MSG@(LN)="----------------------------------------------"
. S LN=LN+1,@MSG@(LN)=" Option: "_OPTNM
. S LN=LN+1,@MSG@(LN)=" Task Number: "_$P(T,U,1)
. S LN=LN+1,@MSG@(LN)=" Queued to Run: "_$$FMTE^XLFDT($P(T,U,2),"5ZPM")
. S LN=LN+1,@MSG@(LN)="Rescheduling Freq: "_$P(T,U,3)
. Q
;
; Address the message
I $G(IBSNDRSQ)="" S XMTO("vhacoebilpm@domain.ext")=""
I $G(IBSNDRSQ)'="" S XMTO(IBSNDRSQ)=""
;
S XMINSTR("FROM")="VistA-eBilling"
;
D SENDMSG^XMXAPI(DUZ,XMSUBJ,MSG,.XMTO,.XMINSTR)
K ^TMP($J,"IBCNSGM") ; clean-up scratch global
I '$D(^TMP("XMERR",$J)) G EMAILX ; no email problems so get out
;
S SUBJ="IB*2*400 - MailMan Error - Ins Co Billing Provider Flag Rpt/Msg"
K MSG S LN=0
S LN=LN+1,MSG(LN)="MailMan reported the following error(s) when attempting to send the"
S LN=LN+1,MSG(LN)="Insurance Company Billing Provider Flag Report."
S LN=LN+1,MSG(LN)=""
S (GLO,GLB)="^TMP(""XMERR"","_$J
S GLO=GLO_")"
F S GLO=$Q(@GLO) Q:GLO'[GLB S LN=LN+1,MSG(LN)=" "_GLO_" = "_$G(@GLO)
S LN=LN+1,MSG(LN)=""
S LN=LN+1,MSG(LN)="This report should be automatically run on a regular schedule through"
S LN=LN+1,MSG(LN)="TaskManager. The VistA option name is IBCN INS BILL PROV FLAG RPT."
S LN=LN+1,MSG(LN)=""
S LN=LN+1,MSG(LN)="Please correct the MailMan problem and re-run this report. If you"
S LN=LN+1,MSG(LN)="need help, please enter a Remedy ticket or call the help desk at"
S LN=LN+1,MSG(LN)="1-888-596-4357."
;
K XMTO,XMINSTR
S XMTO(DUZ)=""
S XMINSTR("FROM")="VistA routine IBCNSGM"
;
; send this local msg to holders of these security keys so they can fix the problems (IA# 10076)
F KEY="XUMGR","XUPROG" S IBX=0 F S IBX=$O(^XUSEC(KEY,IBX)) Q:'IBX S XMTO(IBX)=""
D SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO,.XMINSTR)
K MSG
;
EMAILX ;
Q
;
SRV ; server entry point
; send the report and the TaskManager schedule at the site back to the sender of the server request
;IB*2.0*516/TAZ - This is an inbound server request. It cannot be removed.
G SRVX
N MMHD,IBSNDRSQ
I '$G(XMZ) G SRVX ; only for processing incoming server requests
S MMHD=$$NET^XMRENT(XMZ) ; mailman header information
S IBSNDRSQ=$TR($P(MMHD,U,3),"<>") ; sender of server request
D EN ; send message
D ZAPSERV^XMXAPI("S.IBCNSRVBP",XMZ) ; delete msg from server basket
SRVX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSGM 6613 printed Apr 09, 2024@21:10:24 Page 2
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
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; entry point also from the top
+1 ; production account only
IF '$$PROD^XUPROD(1)
GOTO EX
+2 DO COMPILE
+3 DO EMAIL
EX ;
+1 QUIT
+2 ;
COMPILE ; Build a sorted scratch global of payers in switchback mode
+1 NEW IEN,Z,FLGP,FLGI,DATA,ADDR,EDI,PROFID,INSTID,NAME,STREET,CITY,STATE,TRANS,SWBCK,TMP
+2 KILL ^TMP($JOB,"IBCNSGM")
+3 SET IEN=0
FOR
SET IEN=$ORDER(^DIC(36,IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 ; skip inactive insurance companies
IF '$$ACTIVE^IBCNEUT4(IEN)
QUIT
+5 SET Z=$GET(^DIC(36,IEN,4))
+6 ; prof switchback flag
SET FLGP=+$PIECE(Z,U,11)
+7 ; inst switchback flag
SET FLGI=+$PIECE(Z,U,12)
+8 ; both switchback flags are off
IF 'FLGP
IF 'FLGI
QUIT
+9 SET DATA=$GET(^DIC(36,IEN,0))
+10 SET ADDR=$GET(^DIC(36,IEN,.11))
+11 SET EDI=$GET(^DIC(36,IEN,3))
+12 SET PROFID=$PIECE(EDI,U,2)
+13 SET INSTID=$PIECE(EDI,U,4)
+14 SET NAME=$PIECE(DATA,U,1)
if NAME=""
SET NAME="~UNK"
+15 SET STREET=$PIECE(ADDR,U,1)
+16 SET CITY=$PIECE(ADDR,U,4)
+17 SET STATE=+$PIECE(ADDR,U,5)
+18 SET STATE=$SELECT(STATE:$PIECE($GET(^DIC(5,STATE,0)),U,2),1:"")
+19 SET TRANS=$$EXTERNAL^DILFD(36,3.01,,$PIECE(EDI,U,1))
+20 SET SWBCK=""
+21 IF FLGP
IF FLGI
SET SWBCK="BOTH"
+22 IF FLGP
IF 'FLGI
SET SWBCK="PROF"
+23 IF 'FLGP
IF FLGI
SET SWBCK="INST"
+24 ;
+25 SET TMP=STREET_U_CITY_U_STATE_U_SWBCK_U_TRANS_U_INSTID_U_PROFID
+26 SET ^TMP($JOB,"IBCNSGM",1,NAME,IEN)=TMP
+27 SET ^TMP($JOB,"IBCNSGM",1)=$GET(^TMP($JOB,"IBCNSGM",1))+1
+28 QUIT
End DoDot:1
COMPX ;
+1 QUIT
+2 ;
EMAIL ; Construct the subject and text of the message and send it
+1 NEW MSG,LN,SITE,ZNP,XMSUBJ,XMTO,NM,IEN,TMP,DISP,CITY,SUBJ,GLO,GLB,KEY,IBX,XMINSTR
+2 SET SITE=$$SITE^VASITE
+3 SET ZNP=+$GET(^TMP($JOB,"IBCNSGM",1))
+4 SET XMSUBJ="Switchback Mode - "_$PIECE(SITE,U,3)_" - "_ZNP_" Payer"_$SELECT(ZNP=1:"",1:"s")_" - "_$PIECE(SITE,U,2)
+5 SET XMSUBJ=$EXTRACT(XMSUBJ,1,65)
+6 SET MSG=$NAME(^TMP($JOB,"IBCNSGM",2))
+7 KILL @MSG
+8 SET LN=0
+9 SET LN=LN+1
SET @MSG@(LN)="This report shows VistA insurance companies which are in IB patch 400 switchback mode for the following site."
+10 SET LN=LN+1
SET @MSG@(LN)=""
+11 SET LN=LN+1
SET @MSG@(LN)=" Name: "_$PIECE(SITE,U,2)
+12 SET LN=LN+1
SET @MSG@(LN)=" Station#: "_$PIECE(SITE,U,3)
+13 SET LN=LN+1
SET @MSG@(LN)=" Domain: "_$GET(^XMB("NETNAME"))
+14 SET LN=LN+1
SET @MSG@(LN)=" Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT,"5ZPM")
+15 SET LN=LN+1
SET @MSG@(LN)=""
+16 SET LN=LN+1
SET @MSG@(LN)=""
+17 SET LN=LN+1
SET @MSG@(LN)="Insurance Street Switch Electron Inst Prof"
+18 SET LN=LN+1
SET @MSG@(LN)="Company Name Address City Back Transmit ID ID"
+19 SET LN=LN+1
SET @MSG@(LN)="---------------------------------------------------------------------------------------------------"
+20 ;
+21 SET NM=""
FOR
SET NM=$ORDER(^TMP($JOB,"IBCNSGM",1,NM))
if NM=""
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,"IBCNSGM",1,NM,IEN))
if 'IEN
QUIT
Begin DoDot:1
+22 SET TMP=$GET(^TMP($JOB,"IBCNSGM",1,NM,IEN))
+23 ; ins co name
SET DISP=$$FO^IBCNEUT1(NM,24)_" "
+24 ; street address
SET DISP=DISP_$$FO^IBCNEUT1($PIECE(TMP,U,1),18)_" "
+25 SET CITY=$EXTRACT($PIECE(TMP,U,2),1,16)
+26 IF CITY'=""
IF $PIECE(TMP,U,3)'=""
SET CITY=CITY_","
+27 SET CITY=CITY_$PIECE(TMP,U,3)
+28 ; city, state
SET DISP=DISP_$$FO^IBCNEUT1(CITY,19)_" "
+29 ; switchback flag value
SET DISP=DISP_$$FO^IBCNEUT1($PIECE(TMP,U,4),4)_" "
+30 ; electronic transmit flag
SET DISP=DISP_$$FO^IBCNEUT1($PIECE(TMP,U,5),8)_" "
+31 ; inst payer ID
SET DISP=DISP_$$FO^IBCNEUT1($PIECE(TMP,U,6),8)_" "
+32 ; prof payer ID
SET DISP=DISP_$$FO^IBCNEUT1($PIECE(TMP,U,7),8)
+33 SET LN=LN+1
SET @MSG@(LN)=DISP
+34 QUIT
End DoDot:1
+35 ;
+36 IF 'ZNP
Begin DoDot:1
+37 SET LN=LN+1
SET @MSG@(LN)=""
+38 SET LN=LN+1
SET @MSG@(LN)=" No Data Found"
+39 QUIT
End DoDot:1
+40 ;
+41 SET LN=LN+1
SET @MSG@(LN)=""
+42 SET LN=LN+1
SET @MSG@(LN)="Total number of companies in switchback mode: "_ZNP
+43 SET LN=LN+1
SET @MSG@(LN)=""
+44 SET LN=LN+1
SET @MSG@(LN)="*** End of Report ***"
+45 ;
+46 ; display taskman schedule information for server request
+47 IF $GET(IBSNDRSQ)'=""
Begin DoDot:1
+48 NEW OPTNM,IBZ,T
+49 SET OPTNM="IBCN INS BILL PROV FLAG RPT"
+50 DO OPTSTAT^XUTMOPT(OPTNM,.IBZ)
+51 SET T=$GET(IBZ(1))
+52 SET LN=LN+1
SET @MSG@(LN)=""
+53 SET LN=LN+1
SET @MSG@(LN)=""
+54 SET LN=LN+1
SET @MSG@(LN)="TaskManager Schedule Report for server request"
+55 SET LN=LN+1
SET @MSG@(LN)="----------------------------------------------"
+56 SET LN=LN+1
SET @MSG@(LN)=" Option: "_OPTNM
+57 SET LN=LN+1
SET @MSG@(LN)=" Task Number: "_$PIECE(T,U,1)
+58 SET LN=LN+1
SET @MSG@(LN)=" Queued to Run: "_$$FMTE^XLFDT($PIECE(T,U,2),"5ZPM")
+59 SET LN=LN+1
SET @MSG@(LN)="Rescheduling Freq: "_$PIECE(T,U,3)
+60 QUIT
End DoDot:1
+61 ;
+62 ; Address the message
+63 IF $GET(IBSNDRSQ)=""
SET XMTO("vhacoebilpm@domain.ext")=""
+64 IF $GET(IBSNDRSQ)'=""
SET XMTO(IBSNDRSQ)=""
+65 ;
+66 SET XMINSTR("FROM")="VistA-eBilling"
+67 ;
+68 DO SENDMSG^XMXAPI(DUZ,XMSUBJ,MSG,.XMTO,.XMINSTR)
+69 ; clean-up scratch global
KILL ^TMP($JOB,"IBCNSGM")
+70 ; no email problems so get out
IF '$DATA(^TMP("XMERR",$JOB))
GOTO EMAILX
+71 ;
+72 SET SUBJ="IB*2*400 - MailMan Error - Ins Co Billing Provider Flag Rpt/Msg"
+73 KILL MSG
SET LN=0
+74 SET LN=LN+1
SET MSG(LN)="MailMan reported the following error(s) when attempting to send the"
+75 SET LN=LN+1
SET MSG(LN)="Insurance Company Billing Provider Flag Report."
+76 SET LN=LN+1
SET MSG(LN)=""
+77 SET (GLO,GLB)="^TMP(""XMERR"","_$JOB
+78 SET GLO=GLO_")"
+79 FOR
SET GLO=$QUERY(@GLO)
if GLO'[GLB
QUIT
SET LN=LN+1
SET MSG(LN)=" "_GLO_" = "_$GET(@GLO)
+80 SET LN=LN+1
SET MSG(LN)=""
+81 SET LN=LN+1
SET MSG(LN)="This report should be automatically run on a regular schedule through"
+82 SET LN=LN+1
SET MSG(LN)="TaskManager. The VistA option name is IBCN INS BILL PROV FLAG RPT."
+83 SET LN=LN+1
SET MSG(LN)=""
+84 SET LN=LN+1
SET MSG(LN)="Please correct the MailMan problem and re-run this report. If you"
+85 SET LN=LN+1
SET MSG(LN)="need help, please enter a Remedy ticket or call the help desk at"
+86 SET LN=LN+1
SET MSG(LN)="1-888-596-4357."
+87 ;
+88 KILL XMTO,XMINSTR
+89 SET XMTO(DUZ)=""
+90 SET XMINSTR("FROM")="VistA routine IBCNSGM"
+91 ;
+92 ; send this local msg to holders of these security keys so they can fix the problems (IA# 10076)
+93 FOR KEY="XUMGR","XUPROG"
SET IBX=0
FOR
SET IBX=$ORDER(^XUSEC(KEY,IBX))
if 'IBX
QUIT
SET XMTO(IBX)=""
+94 DO SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO,.XMINSTR)
+95 KILL MSG
+96 ;
EMAILX ;
+1 QUIT
+2 ;
SRV ; server entry point
+1 ; send the report and the TaskManager schedule at the site back to the sender of the server request
+2 ;IB*2.0*516/TAZ - This is an inbound server request. It cannot be removed.
+3 GOTO SRVX
+4 NEW MMHD,IBSNDRSQ
+5 ; only for processing incoming server requests
IF '$GET(XMZ)
GOTO SRVX
+6 ; mailman header information
SET MMHD=$$NET^XMRENT(XMZ)
+7 ; sender of server request
SET IBSNDRSQ=$TRANSLATE($PIECE(MMHD,U,3),"<>")
+8 ; send message
DO EN
+9 ; delete msg from server basket
DO ZAPSERV^XMXAPI("S.IBCNSRVBP",XMZ)
SRVX ;
+1 QUIT
+2 ;
