IBE585PO ;DAL/JCH - Patch IB*2.0*585 Post Install ;22-JUN-17
;;2.0;INTEGRATED BILLING;**585**;21-MAR-94;Build 68
; This routine uses the following IAs:
; #4640 - ^HDISVF01 calls (supported)
; #4639 - ^HDISVCMR calls (supported)
; #4651 - ^HDISVF09 calls (supported)
;
EN ;MAIN ENTRY POINT
N SUCCESS,DEMFAC,X,Y,DA,X1,X2,ZTRTN,ZTDESC,ZTDTH,TMP,DOMPTR,DIE,DA,DR,FIL,DOMPTR,DOMAIN
S DEMFAC=$$KSP^XUPARAM("INST")
S DOMAIN="PAYERS"
S SUCCESS=$$GETIEN^HDISVF09(DOMAIN,.DOMPTR)
I 'SUCCESS!'+$G(DOMPTR) D Q
.D MES^XPDUTL("***** Error retrieving the IEN for the "_DOMAIN_" domain.")
.D PSTHALT("File #355.99 'seeding' was not performed.")
S FIL=355.99 D HDIS(FIL,DOMPTR,DOMAIN)
Q
;
HDIS(FIL,DOMPTR,DOMAIN) ; do HDIS "seeding"
N TMP,HDIMSG,B,C
;
; New file can't be seeded if there is no data?
I '$O(^IBEMTOP(355.99,0)) D DUMSEED
D PSEED(355.99,DOMPTR,DOMAIN)
;
Q
;
PSEED(FIL,DOMPTR,DOMAIN) ; Check for previous "seeding"(deployment), quit if already done.
N ASTATUS,TMP,XPROD,IBSITE,XMSUB,XMDUZ,XMY,HDITEXT,FILNAM,MSG,XMTEXT,XMZ
;
S ASTATUS=$P($$GETSTAT^HDISVF01(FIL),U)
I ASTATUS>3 S MSG="File: "_FIL_" Has already been seeded. Status is: "_ASTATUS D PSTHALT(MSG) Q
;
; set the seeding status to complete for data deployments.
D SETSTAT^HDISVF01(FIL,,4)
;
; send message to STS that patch is installed and the current status
D FILE^DID(FIL,"","NAME","FILNAM","ERR")
S FILNAM=$G(FILNAM("NAME"))
S XPROD=$$PROD^XUPROD()
S IBSITE=$$SITE^VASITE()
S XMSUB="Site: "_$P(IBSITE,"^",2)_" File: "_FIL_" in "_($S(XPROD:"PRODUCTION",1:"TEST"))_" ready for ERT Update"
S XMY("G.HDIS ERT NOTIFICATION@DOMAIN.EXT")=""
S XMDUZ="Site: "_$P(IBSITE,"^",3)_" Patch Install IB*2.0*585 is Complete"
S XMY(DUZ)=""
K HDITEXT
S HDITEXT(1)=""
S HDITEXT(2)="Site: "_$P(IBSITE,"^",2)_" - "_$P(IBSITE,"^",3)
S HDITEXT(2)=HDITEXT(2)_" with Domain/IP Address of "_$G(^XMB("NETNAME")) ;facility name
S HDITEXT(3)="Has Installed Patch IB*2.0*585 into their "_$S(XPROD:"PRODUCTION",1:"TEST")_" System Environment"
S HDITEXT(4)="The Patch was Installed on: "
S B=$$NOW^XLFDT N Y S Y=B D DD^%DT S HDITEXT(4)=HDITEXT(4)_Y ;date/time
S HDITEXT(5)=""
S HDITEXT(6)="Patch IB*2.0*585 has standardized file: "_FILNAM_" (#"_FIL_")"
S HDITEXT(7)=""
S HDITEXT(8)="The current HDIS status of file #"_FIL_"is: "_$P($$GETSTAT^HDISVF01(FIL),U)
S HDITEXT(9)=""
S HDITEXT(10)="Site: "_$P(IBSITE,"^",2)_" - "_$P(IBSITE,"^",3)_" needs full file update of the "_FILNAM_" file (#"_FIL_" as soon as possible."
S HDITEXT(11)=""
N DIFROM S XMTEXT="HDITEXT(" D ^XMD K DIFROM
S MSG="File: "_FIL_" Has been 'seeded'. Message Number: "_$G(XMZ) D PSTDONE(MSG)
Q
;
PSTDONE(MSG) ; display FINISHED message
N HDIMSG
S HDIMSG(1)=""
S HDIMSG(2)=MSG
S HDIMSG(3)="***** Post-installation of Patch IB*2.0*585 HDIS 'seeding' "_FILNAM_" file (#"_FIL_") has Completed."
S HDIMSG(4)="***** An update message has been sent to Enterprise VistA Support."
S HDIMSG(5)=""
D MES^XPDUTL(.HDIMSG)
Q
;
PSTHALT(MSG) ; display error message
S HDIMSG(1)=""
S HDIMSG(2)=MSG
S HDIMSG(3)="***** Post-installation of Patch IB*2.0*585 HDIS 'seeding' has been halted."
S HDIMSG(4)="***** Please contact Enterprise VistA Support."
S HDIMSG(5)=""
D MES^XPDUTL(.HDIMSG)
Q
;
DUMSEED ; New file 355.99 contains no data, can't be seeded unless there is at least one entry?
;
; MASTER TYPE OF PLAN (#355.99) file initial population data elements from DAT35599 line tag;
;
; IBDATA ";" PIECE - FIELD # - FIELD NAME
; PIECE #1 - n/a - IEN
; PIECE #2 - .01 - PLAN NAME
; PIECE #3 - 1 - PHDSC SOURCE OF PAYMENT
;
N IBMTOPI,IBMFILE,IBDATA,IBDATLN,IBFDA,IBRSLT,XUMF
S IBMFILE=355.99
S XUMF=1
F IBDATLN=1:1 S IBDATA=$P($T(DAT35599+IBDATLN),";",3,10) Q:IBDATA="" D
.N IBMTOPI,IBFDA,IBFDAIEN,IBEFFDT
.S IBMTOPI=$P(IBDATA,";")
.S IBFDA(355.99,"+1,",.01)=$P(IBDATA,";",2)
.S IBFDA(355.99,"+1,",1)=$P(IBDATA,";",3)
.S IBFDAIEN(1)=IBMTOPI
.S IBRSLT=$$INSREC(IBMFILE,IBMTOPI,.IBFDA,.IBFDAIEN)
Q
;
INSREC(IBFILE,IBIEN,IBFDA,IBFDAIEN) ; Insert IBIEN into file IBFILE with data in IBFDA
I ('$G(IBFILE)) Q "0^Invalid parameter"
N IBDERR
I '$G(IBFDAIEN(1)) S IBFDAIEN="",IBFDAIEN(1)=""
D UPDATE^DIE("","IBFDA","IBFDAIEN","IBDERR")
I $D(IBDERR) Q -1
Q +$G(IBFDA)
;
;
; IBDATA ";" PIECE - FIELD # - FIELD NAME
; PIECE #1 - n/a - IEN
; PIECE #2 - .01 - PLAN NAME
; PIECE #3 - 1 - PHDSC SOURCE OF PAYMENT
;
DAT35599 ; Data to populate the MASTER TYPE OF PLAN (#355.99) file
;;1;MEDICARE;1
;;2;Medicare (Managed Care);11
;;3;Medicare HMO;111
;;4;Medicare PPO;112
;;5;Medicare POS;113
;;6;Medicare Managed Care Other;119
;;7;Medicare (Non-managed Care);12
;;8;Medicare FFS;121
;;9;Medicare Drug Benefit;122
;;10;Medicare Medical Savings Account (MSA);123
;;11;Medicare Non-managed Care Other;129
;;12;Medicare Hospice;13
;;13;Dual Eligibility Medicare/Medicaid Organization;14
;;14;Medicare Other;19
;;15;Medicare Pharmacy Benefit Manager;191
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBE585PO 5163 printed Sep 23, 2025@19:57:21 Page 2
IBE585PO ;DAL/JCH - Patch IB*2.0*585 Post Install ;22-JUN-17
+1 ;;2.0;INTEGRATED BILLING;**585**;21-MAR-94;Build 68
+2 ; This routine uses the following IAs:
+3 ; #4640 - ^HDISVF01 calls (supported)
+4 ; #4639 - ^HDISVCMR calls (supported)
+5 ; #4651 - ^HDISVF09 calls (supported)
+6 ;
EN ;MAIN ENTRY POINT
+1 NEW SUCCESS,DEMFAC,X,Y,DA,X1,X2,ZTRTN,ZTDESC,ZTDTH,TMP,DOMPTR,DIE,DA,DR,FIL,DOMPTR,DOMAIN
+2 SET DEMFAC=$$KSP^XUPARAM("INST")
+3 SET DOMAIN="PAYERS"
+4 SET SUCCESS=$$GETIEN^HDISVF09(DOMAIN,.DOMPTR)
+5 IF 'SUCCESS!'+$GET(DOMPTR)
Begin DoDot:1
+6 DO MES^XPDUTL("***** Error retrieving the IEN for the "_DOMAIN_" domain.")
+7 DO PSTHALT("File #355.99 'seeding' was not performed.")
End DoDot:1
QUIT
+8 SET FIL=355.99
DO HDIS(FIL,DOMPTR,DOMAIN)
+9 QUIT
+10 ;
HDIS(FIL,DOMPTR,DOMAIN) ; do HDIS "seeding"
+1 NEW TMP,HDIMSG,B,C
+2 ;
+3 ; New file can't be seeded if there is no data?
+4 IF '$ORDER(^IBEMTOP(355.99,0))
DO DUMSEED
+5 DO PSEED(355.99,DOMPTR,DOMAIN)
+6 ;
+7 QUIT
+8 ;
PSEED(FIL,DOMPTR,DOMAIN) ; Check for previous "seeding"(deployment), quit if already done.
+1 NEW ASTATUS,TMP,XPROD,IBSITE,XMSUB,XMDUZ,XMY,HDITEXT,FILNAM,MSG,XMTEXT,XMZ
+2 ;
+3 SET ASTATUS=$PIECE($$GETSTAT^HDISVF01(FIL),U)
+4 IF ASTATUS>3
SET MSG="File: "_FIL_" Has already been seeded. Status is: "_ASTATUS
DO PSTHALT(MSG)
QUIT
+5 ;
+6 ; set the seeding status to complete for data deployments.
+7 DO SETSTAT^HDISVF01(FIL,,4)
+8 ;
+9 ; send message to STS that patch is installed and the current status
+10 DO FILE^DID(FIL,"","NAME","FILNAM","ERR")
+11 SET FILNAM=$GET(FILNAM("NAME"))
+12 SET XPROD=$$PROD^XUPROD()
+13 SET IBSITE=$$SITE^VASITE()
+14 SET XMSUB="Site: "_$PIECE(IBSITE,"^",2)_" File: "_FIL_" in "_($SELECT(XPROD:"PRODUCTION",1:"TEST"))_" ready for ERT Update"
+15 SET XMY("G.HDIS ERT NOTIFICATION@DOMAIN.EXT")=""
+16 SET XMDUZ="Site: "_$PIECE(IBSITE,"^",3)_" Patch Install IB*2.0*585 is Complete"
+17 SET XMY(DUZ)=""
+18 KILL HDITEXT
+19 SET HDITEXT(1)=""
+20 SET HDITEXT(2)="Site: "_$PIECE(IBSITE,"^",2)_" - "_$PIECE(IBSITE,"^",3)
+21 ;facility name
SET HDITEXT(2)=HDITEXT(2)_" with Domain/IP Address of "_$GET(^XMB("NETNAME"))
+22 SET HDITEXT(3)="Has Installed Patch IB*2.0*585 into their "_$SELECT(XPROD:"PRODUCTION",1:"TEST")_" System Environment"
+23 SET HDITEXT(4)="The Patch was Installed on: "
+24 ;date/time
SET B=$$NOW^XLFDT
NEW Y
SET Y=B
DO DD^%DT
SET HDITEXT(4)=HDITEXT(4)_Y
+25 SET HDITEXT(5)=""
+26 SET HDITEXT(6)="Patch IB*2.0*585 has standardized file: "_FILNAM_" (#"_FIL_")"
+27 SET HDITEXT(7)=""
+28 SET HDITEXT(8)="The current HDIS status of file #"_FIL_"is: "_$PIECE($$GETSTAT^HDISVF01(FIL),U)
+29 SET HDITEXT(9)=""
+30 SET HDITEXT(10)="Site: "_$PIECE(IBSITE,"^",2)_" - "_$PIECE(IBSITE,"^",3)_" needs full file update of the "_FILNAM_" file (#"_FIL_" as soon as possible."
+31 SET HDITEXT(11)=""
+32 NEW DIFROM
SET XMTEXT="HDITEXT("
DO ^XMD
KILL DIFROM
+33 SET MSG="File: "_FIL_" Has been 'seeded'. Message Number: "_$GET(XMZ)
DO PSTDONE(MSG)
+34 QUIT
+35 ;
PSTDONE(MSG) ; display FINISHED message
+1 NEW HDIMSG
+2 SET HDIMSG(1)=""
+3 SET HDIMSG(2)=MSG
+4 SET HDIMSG(3)="***** Post-installation of Patch IB*2.0*585 HDIS 'seeding' "_FILNAM_" file (#"_FIL_") has Completed."
+5 SET HDIMSG(4)="***** An update message has been sent to Enterprise VistA Support."
+6 SET HDIMSG(5)=""
+7 DO MES^XPDUTL(.HDIMSG)
+8 QUIT
+9 ;
PSTHALT(MSG) ; display error message
+1 SET HDIMSG(1)=""
+2 SET HDIMSG(2)=MSG
+3 SET HDIMSG(3)="***** Post-installation of Patch IB*2.0*585 HDIS 'seeding' has been halted."
+4 SET HDIMSG(4)="***** Please contact Enterprise VistA Support."
+5 SET HDIMSG(5)=""
+6 DO MES^XPDUTL(.HDIMSG)
+7 QUIT
+8 ;
DUMSEED ; New file 355.99 contains no data, can't be seeded unless there is at least one entry?
+1 ;
+2 ; MASTER TYPE OF PLAN (#355.99) file initial population data elements from DAT35599 line tag;
+3 ;
+4 ; IBDATA ";" PIECE - FIELD # - FIELD NAME
+5 ; PIECE #1 - n/a - IEN
+6 ; PIECE #2 - .01 - PLAN NAME
+7 ; PIECE #3 - 1 - PHDSC SOURCE OF PAYMENT
+8 ;
+9 NEW IBMTOPI,IBMFILE,IBDATA,IBDATLN,IBFDA,IBRSLT,XUMF
+10 SET IBMFILE=355.99
+11 SET XUMF=1
+12 FOR IBDATLN=1:1
SET IBDATA=$PIECE($TEXT(DAT35599+IBDATLN),";",3,10)
if IBDATA=""
QUIT
Begin DoDot:1
+13 NEW IBMTOPI,IBFDA,IBFDAIEN,IBEFFDT
+14 SET IBMTOPI=$PIECE(IBDATA,";")
+15 SET IBFDA(355.99,"+1,",.01)=$PIECE(IBDATA,";",2)
+16 SET IBFDA(355.99,"+1,",1)=$PIECE(IBDATA,";",3)
+17 SET IBFDAIEN(1)=IBMTOPI
+18 SET IBRSLT=$$INSREC(IBMFILE,IBMTOPI,.IBFDA,.IBFDAIEN)
End DoDot:1
+19 QUIT
+20 ;
INSREC(IBFILE,IBIEN,IBFDA,IBFDAIEN) ; Insert IBIEN into file IBFILE with data in IBFDA
+1 IF ('$GET(IBFILE))
QUIT "0^Invalid parameter"
+2 NEW IBDERR
+3 IF '$GET(IBFDAIEN(1))
SET IBFDAIEN=""
SET IBFDAIEN(1)=""
+4 DO UPDATE^DIE("","IBFDA","IBFDAIEN","IBDERR")
+5 IF $DATA(IBDERR)
QUIT -1
+6 QUIT +$GET(IBFDA)
+7 ;
+8 ;
+9 ; IBDATA ";" PIECE - FIELD # - FIELD NAME
+10 ; PIECE #1 - n/a - IEN
+11 ; PIECE #2 - .01 - PLAN NAME
+12 ; PIECE #3 - 1 - PHDSC SOURCE OF PAYMENT
+13 ;
DAT35599 ; Data to populate the MASTER TYPE OF PLAN (#355.99) file
+1 ;;1;MEDICARE;1
+2 ;;2;Medicare (Managed Care);11
+3 ;;3;Medicare HMO;111
+4 ;;4;Medicare PPO;112
+5 ;;5;Medicare POS;113
+6 ;;6;Medicare Managed Care Other;119
+7 ;;7;Medicare (Non-managed Care);12
+8 ;;8;Medicare FFS;121
+9 ;;9;Medicare Drug Benefit;122
+10 ;;10;Medicare Medical Savings Account (MSA);123
+11 ;;11;Medicare Non-managed Care Other;129
+12 ;;12;Medicare Hospice;13
+13 ;;13;Dual Eligibility Medicare/Medicaid Organization;14
+14 ;;14;Medicare Other;19
+15 ;;15;Medicare Pharmacy Benefit Manager;191
+16 QUIT
