IBY608PO ;ALB/KDM - POST-INSTALL FOR IB*2.0*608 ;13-DEC-2017
;;2.0;INTEGRATED BILLING;**608**;21-MAR-94;Build 90
;;Per VA Directive 6402, this routine should not be modified.
;
;KDM 12/2017 US1909
; run report of all insurance companies that have the current setting for Transmit Electronically set to zero- which is NO
; send email of report to eBiz rapid response group
N IBA,RNAME
S RNAME="IBY608PO"
K ^TMP(RNAME,$J)
S IBA(2)="IB*2*608 Post-Install...",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
D MES^XPDUTL(">> Running Insurance Company EDI Parameter Report...please stand by....")
D RPT
D MES^XPDUTL(">> Report Completed.")
D CMNCPT
D:$$PROD^XUPROD(1) EMAIL ;LIVE
S IBA(2)="IB*2*608 Post-Install Complete.",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
Q
;
RPT ; Get all Insurance companies that have the 3.01- transmit electronically field blank or set to No.
;N IBADDRESS,IBCITY,IBNAME,IBPIEN,IBSTATE,STATE,TRANSCD,TRANSMIT
N IBADDRESS,IBCITY,IBNAME,IBPIEN,IBSTATE,INACTFLG,STATE,TRANSMIT
S IBNAME=""
F S IBNAME=$O(^DIC(36,"B",IBNAME)) Q:IBNAME="" D
. S IBPIEN=0
. F S IBPIEN=$O(^DIC(36,"B",IBNAME,IBPIEN)) Q:'+IBPIEN D
. . S TRANSMIT=$$GET1^DIQ(36,IBPIEN,3.01,"I")
. . Q:+TRANSMIT ;Only want to report the insurance companies that have a setting of 0 or NULL
. . S (IBADDRESS,IBCITY,IBSTATE,INACTFLG,STATE)=""
. . S IBADDRESS=$$GET1^DIQ(36,IBPIEN,.111)
. . S IBCITY=$$GET1^DIQ(36,IBPIEN,.114)
. . S IBSTATE=$$GET1^DIQ(36,IBPIEN,.115,"I")
. . I +IBSTATE S STATE=$$GET1^DIQ(5,+IBSTATE,1)
. . S INACTFLG=$$GET1^DIQ(36,IBPIEN,.05)
. . I INACTFLG="" S INACTFLG=""
. . S ^TMP(RNAME,$J,IBNAME,IBPIEN)=IBADDRESS_U_IBCITY_U_STATE_U_INACTFLG_U_$S(TRANSMIT="":"",1:"NO")
Q
;
EMAIL ; Send an email message to eBiz Rapid Response group with the report.
N ADDRESS,CITY,DATA,FULLADD,IBNAME,IBNAMEX,IBPIEN,INACTFLG,LN,MSG
N SPACES,SITE,SITENAME,SITENO,STATE,STATION,SUBJ,TOTAL,TRANS,TRANSCD,XMINSTR,XMTO
D BMES^XPDUTL(">> Sending Email...")
D MES^XPDUTL("-------------")
D MES^XPDUTL("Sending email notification to eBiz Rapid response group ... ")
;S SPACES=$J(" ",100)
S $P(SPACES,"_",100)="_"
S SITE=$$SITE^VASITE,SITENAME=$P(SITE,U,2),SITENO=$P(SITE,U,1),STATION=$P(SITE,U,3)
S SUBJ="PATCH IB*2.0*608 - Insurance Company EDI Report"_" for Station# "_$P(SITE,U,3)_" - "_$P(SITE,U,2)
S SUBJ=$E(SUBJ,1,65)
S MSG(1)="PATCH IB*2.0*608 - Insurance Company EDI Parameter Report"
S MSG(2)=""
S MSG(3)="Site: "_SITENO_" "_SITENAME_" - Station "_STATION
S MSG(4)="Domain: "_$G(^XMB("NETNAME"))
S MSG(5)="Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT)
S MSG(6)=""
S MSG(7)="INSURANCE COMPANY__________________ADDRESS__________________________________________________________INACTIVE____EDI-TRANSMIT"
S MSG(8)="============================================================================================================================"
S MSG(9)=""
S LN=10,IBNAME="",TOTAL=0
F S IBNAME=$O(^TMP(RNAME,$J,IBNAME)) Q:IBNAME="" D
. S IBPIEN=""
. F S IBPIEN=$O(^TMP(RNAME,$J,IBNAME,IBPIEN)) Q:IBPIEN="" D
. . S DATA=^TMP(RNAME,$J,IBNAME,IBPIEN)
. . S IBNAMEX=$$UNSPACE($E(IBNAME,1,30))
. . S ADDRESS=$$UNSPACE($E($P(DATA,U,1),1,30)),CITY=$$UNSPACE($E($P(DATA,U,2),1,25)),STATE=$$UNSPACE($P(DATA,U,3))
. . S FULLADD=ADDRESS_", "_CITY_", "_STATE
. . I '$L(ADDRESS),'$L(CITY),'$L(STATE) S FULLADD=""
. . S INACTFLG=$P(DATA,U,4)
. . S TRANS=$P(DATA,U,5)
. . S LN=LN+1,MSG(LN)=IBNAMEX_$E(SPACES,1,35-$L(IBNAMEX))_FULLADD_$E(SPACES,1,68-$L(FULLADD))
. . S MSG(LN)=MSG(LN)_INACTFLG_$E(SPACES,1,15-$L(INACTFLG))_TRANS
. . S TOTAL=TOTAL+1
S LN=LN+1,MSG(LN)=""
S LN=LN+1,MSG(LN)="Total: "_+TOTAL
S LN=LN+1,MSG(LN)=""
S LN=LN+1,MSG(LN)="End of Report"
;
; ***testing email to vito,anne,cj,jane vs live*** must change back to live before putting in build ***
;S XMTO("vito.d'amico@domain.ext")=""
;S XMTO("anne.debacker@domain.ext")=""
;S XMTO("cherie.minch@domain.ext")=""
;S XMTO("jane.balchunas@domain.ext")=""
;S XMTO("william.jutzi@domain.ext")=""
S XMTO("VHAeBillingRR@domain.ext")=""
;
S XMINSTR("FROM")="VistA-eBilling"
D SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO,.XMINSTR)
;
EMAILX ;
D MES^XPDUTL(" Done.")
D CLEAN^DILF
Q
;
UNSPACE(FLDX) ; Eliminate spaces at the end of the field.
N I
F S I=$L(FLDX) Q:($E(FLDX,I)'=" ") I $E(FLDX,I)=" " S FLDX=$E(FLDX,1,I-1)
Q FLDX
;
CMNCPT ;Set CMN CPT CODES in IB System Parameters
D MES^XPDUTL("Setting CMN CPT Codes in IB SITE PARAMETER file.....")
N CODES,CPTCD,CPTIEN,CPTS,DA,DIC,DIE,DR,ERRMSG,FDA,I,RETIEN
S CODES=""
F I=1:1 S CPTS=$P($T(CPTCD+I),";;",2) Q:CPTS="" S CODES=$S(CODES="":CPTS,1:CODES_U_CPTS)
F I=1:1 S CPTCD=$P(CODES,U,I) Q:CPTCD="" D
. S CPTIEN=$$FIND1^DIC(81,,"X",CPTCD) Q:'CPTIEN
. I $D(^IBE(350.9,1,16,"B",CPTIEN)) Q
. K FDA,ERRMSG,RETIEN
. S FDA(350.916,"+1,1,",.01)=CPTIEN
. D UPDATE^DIE("","FDA","RETIEN","ERRMSG")
D MES^XPDUTL(".....CMN CPT Codes set. ")
Q
;
CPTCD ;
;;B4102^B4103^B4104^B4149^B4150^B4152^B4153^B4154^B4155^B4157^B4158^B4159^B4160^B4161^B4162^B4164^B4168
;;B4172^B4176^B4178^B4180^B4185^B4189^B4193^B4197^B4199^B4216^B5000^B5100^B5200^B9002^B9004^B9006^E0424
;;E0431^E0433^E0434^E0439^E0441^E0442^E0443^E0444^E0776^E0791^E1390^E1391^E1392^E1405^E1406^K0738
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY608PO 5347 printed Dec 13, 2024@02:34:48 Page 2
IBY608PO ;ALB/KDM - POST-INSTALL FOR IB*2.0*608 ;13-DEC-2017
+1 ;;2.0;INTEGRATED BILLING;**608**;21-MAR-94;Build 90
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;KDM 12/2017 US1909
+5 ; run report of all insurance companies that have the current setting for Transmit Electronically set to zero- which is NO
+6 ; send email of report to eBiz rapid response group
+7 NEW IBA,RNAME
+8 SET RNAME="IBY608PO"
+9 KILL ^TMP(RNAME,$JOB)
+10 SET IBA(2)="IB*2*608 Post-Install..."
SET (IBA(1),IBA(3))=" "
DO MES^XPDUTL(.IBA)
KILL IBA
+11 DO MES^XPDUTL(">> Running Insurance Company EDI Parameter Report...please stand by....")
+12 DO RPT
+13 DO MES^XPDUTL(">> Report Completed.")
+14 DO CMNCPT
+15 ;LIVE
if $$PROD^XUPROD(1)
DO EMAIL
+16 SET IBA(2)="IB*2*608 Post-Install Complete."
SET (IBA(1),IBA(3))=" "
DO MES^XPDUTL(.IBA)
KILL IBA
+17 QUIT
+18 ;
RPT ; Get all Insurance companies that have the 3.01- transmit electronically field blank or set to No.
+1 ;N IBADDRESS,IBCITY,IBNAME,IBPIEN,IBSTATE,STATE,TRANSCD,TRANSMIT
+2 NEW IBADDRESS,IBCITY,IBNAME,IBPIEN,IBSTATE,INACTFLG,STATE,TRANSMIT
+3 SET IBNAME=""
+4 FOR
SET IBNAME=$ORDER(^DIC(36,"B",IBNAME))
if IBNAME=""
QUIT
Begin DoDot:1
+5 SET IBPIEN=0
+6 FOR
SET IBPIEN=$ORDER(^DIC(36,"B",IBNAME,IBPIEN))
if '+IBPIEN
QUIT
Begin DoDot:2
+7 SET TRANSMIT=$$GET1^DIQ(36,IBPIEN,3.01,"I")
+8 ;Only want to report the insurance companies that have a setting of 0 or NULL
if +TRANSMIT
QUIT
+9 SET (IBADDRESS,IBCITY,IBSTATE,INACTFLG,STATE)=""
+10 SET IBADDRESS=$$GET1^DIQ(36,IBPIEN,.111)
+11 SET IBCITY=$$GET1^DIQ(36,IBPIEN,.114)
+12 SET IBSTATE=$$GET1^DIQ(36,IBPIEN,.115,"I")
+13 IF +IBSTATE
SET STATE=$$GET1^DIQ(5,+IBSTATE,1)
+14 SET INACTFLG=$$GET1^DIQ(36,IBPIEN,.05)
+15 IF INACTFLG=""
SET INACTFLG=""
+16 SET ^TMP(RNAME,$JOB,IBNAME,IBPIEN)=IBADDRESS_U_IBCITY_U_STATE_U_INACTFLG_U_$SELECT(TRANSMIT="":"",1:"NO")
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
EMAIL ; Send an email message to eBiz Rapid Response group with the report.
+1 NEW ADDRESS,CITY,DATA,FULLADD,IBNAME,IBNAMEX,IBPIEN,INACTFLG,LN,MSG
+2 NEW SPACES,SITE,SITENAME,SITENO,STATE,STATION,SUBJ,TOTAL,TRANS,TRANSCD,XMINSTR,XMTO
+3 DO BMES^XPDUTL(">> Sending Email...")
+4 DO MES^XPDUTL("-------------")
+5 DO MES^XPDUTL("Sending email notification to eBiz Rapid response group ... ")
+6 ;S SPACES=$J(" ",100)
+7 SET $PIECE(SPACES,"_",100)="_"
+8 SET SITE=$$SITE^VASITE
SET SITENAME=$PIECE(SITE,U,2)
SET SITENO=$PIECE(SITE,U,1)
SET STATION=$PIECE(SITE,U,3)
+9 SET SUBJ="PATCH IB*2.0*608 - Insurance Company EDI Report"_" for Station# "_$PIECE(SITE,U,3)_" - "_$PIECE(SITE,U,2)
+10 SET SUBJ=$EXTRACT(SUBJ,1,65)
+11 SET MSG(1)="PATCH IB*2.0*608 - Insurance Company EDI Parameter Report"
+12 SET MSG(2)=""
+13 SET MSG(3)="Site: "_SITENO_" "_SITENAME_" - Station "_STATION
+14 SET MSG(4)="Domain: "_$GET(^XMB("NETNAME"))
+15 SET MSG(5)="Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT)
+16 SET MSG(6)=""
+17 SET MSG(7)="INSURANCE COMPANY__________________ADDRESS__________________________________________________________INACTIVE____EDI-TRANSMIT"
+18 SET MSG(8)="============================================================================================================================"
+19 SET MSG(9)=""
+20 SET LN=10
SET IBNAME=""
SET TOTAL=0
+21 FOR
SET IBNAME=$ORDER(^TMP(RNAME,$JOB,IBNAME))
if IBNAME=""
QUIT
Begin DoDot:1
+22 SET IBPIEN=""
+23 FOR
SET IBPIEN=$ORDER(^TMP(RNAME,$JOB,IBNAME,IBPIEN))
if IBPIEN=""
QUIT
Begin DoDot:2
+24 SET DATA=^TMP(RNAME,$JOB,IBNAME,IBPIEN)
+25 SET IBNAMEX=$$UNSPACE($EXTRACT(IBNAME,1,30))
+26 SET ADDRESS=$$UNSPACE($EXTRACT($PIECE(DATA,U,1),1,30))
SET CITY=$$UNSPACE($EXTRACT($PIECE(DATA,U,2),1,25))
SET STATE=$$UNSPACE($PIECE(DATA,U,3))
+27 SET FULLADD=ADDRESS_", "_CITY_", "_STATE
+28 IF '$LENGTH(ADDRESS)
IF '$LENGTH(CITY)
IF '$LENGTH(STATE)
SET FULLADD=""
+29 SET INACTFLG=$PIECE(DATA,U,4)
+30 SET TRANS=$PIECE(DATA,U,5)
+31 SET LN=LN+1
SET MSG(LN)=IBNAMEX_$EXTRACT(SPACES,1,35-$LENGTH(IBNAMEX))_FULLADD_$EXTRACT(SPACES,1,68-$LENGTH(FULLADD))
+32 SET MSG(LN)=MSG(LN)_INACTFLG_$EXTRACT(SPACES,1,15-$LENGTH(INACTFLG))_TRANS
+33 SET TOTAL=TOTAL+1
End DoDot:2
End DoDot:1
+34 SET LN=LN+1
SET MSG(LN)=""
+35 SET LN=LN+1
SET MSG(LN)="Total: "_+TOTAL
+36 SET LN=LN+1
SET MSG(LN)=""
+37 SET LN=LN+1
SET MSG(LN)="End of Report"
+38 ;
+39 ; ***testing email to vito,anne,cj,jane vs live*** must change back to live before putting in build ***
+40 ;S XMTO("vito.d'amico@domain.ext")=""
+41 ;S XMTO("anne.debacker@domain.ext")=""
+42 ;S XMTO("cherie.minch@domain.ext")=""
+43 ;S XMTO("jane.balchunas@domain.ext")=""
+44 ;S XMTO("william.jutzi@domain.ext")=""
+45 SET XMTO("VHAeBillingRR@domain.ext")=""
+46 ;
+47 SET XMINSTR("FROM")="VistA-eBilling"
+48 DO SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO,.XMINSTR)
+49 ;
EMAILX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO CLEAN^DILF
+3 QUIT
+4 ;
UNSPACE(FLDX) ; Eliminate spaces at the end of the field.
+1 NEW I
+2 FOR
SET I=$LENGTH(FLDX)
if ($EXTRACT(FLDX,I)'=" ")
QUIT
IF $EXTRACT(FLDX,I)=" "
SET FLDX=$EXTRACT(FLDX,1,I-1)
+3 QUIT FLDX
+4 ;
CMNCPT ;Set CMN CPT CODES in IB System Parameters
+1 DO MES^XPDUTL("Setting CMN CPT Codes in IB SITE PARAMETER file.....")
+2 NEW CODES,CPTCD,CPTIEN,CPTS,DA,DIC,DIE,DR,ERRMSG,FDA,I,RETIEN
+3 SET CODES=""
+4 FOR I=1:1
SET CPTS=$PIECE($TEXT(CPTCD+I),";;",2)
if CPTS=""
QUIT
SET CODES=$SELECT(CODES="":CPTS,1:CODES_U_CPTS)
+5 FOR I=1:1
SET CPTCD=$PIECE(CODES,U,I)
if CPTCD=""
QUIT
Begin DoDot:1
+6 SET CPTIEN=$$FIND1^DIC(81,,"X",CPTCD)
if 'CPTIEN
QUIT
+7 IF $DATA(^IBE(350.9,1,16,"B",CPTIEN))
QUIT
+8 KILL FDA,ERRMSG,RETIEN
+9 SET FDA(350.916,"+1,1,",.01)=CPTIEN
+10 DO UPDATE^DIE("","FDA","RETIEN","ERRMSG")
End DoDot:1
+11 DO MES^XPDUTL(".....CMN CPT Codes set. ")
+12 QUIT
+13 ;
CPTCD ;
+1 ;;B4102^B4103^B4104^B4149^B4150^B4152^B4153^B4154^B4155^B4157^B4158^B4159^B4160^B4161^B4162^B4164^B4168
+2 ;;B4172^B4176^B4178^B4180^B4185^B4189^B4193^B4197^B4199^B4216^B5000^B5100^B5200^B9002^B9004^B9006^E0424
+3 ;;E0431^E0433^E0434^E0439^E0441^E0442^E0443^E0444^E0776^E0791^E1390^E1391^E1392^E1405^E1406^K0738
+4 ;
