IBY652P ;AITC/TAZ-Post Install Routine for Patch 652;10 Jun 19
;;2.0;INTEGRATED BILLING;**652**;21-MAR-94;Build 23
;;Per VA Directive 6402, this routine should not be modified.
;
N IBXPD,XPDIDTOT
S XPDIDTOT=1
;
;
; Task PROC
D PROC(1)
;
; Done...
D MES^XPDUTL("")
D MES^XPDUTL("POST-Install Completed.")
Q
;
PROC(IBXPD) ;Process the MBI File
;Read File into the ^TMP($J) global
N CNT,CCNT,FILENAME,INSTCMP,IOC,GREF,PROD,RCNT,SCNT,SITE,SITESYS,SUB,TCNT
;
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Processing MBI Crosswalk ... ")
;
K ^TMP($J)
;
S SITESYS=$$SITE^VASITE
;
I (DT>3200131) G PROCQ ;Past the compliance date, no longer processing files.
;
I $P(SITESYS,U,3)=358 G PROCQ ;If site is Manila, DO NOT process
;
S PROD=$$PROD^XUPROD(1)
S INSTCMP=$$GET1^DIQ(9.7,$O(^XPD(9.7,"B","IB*2.0*652",""),-1)_",",.02,"I")=3
F SITE=405,515,518,585,662 S IOC(SITE)=""
;
I 'PROD,'$D(IOC($P(SITESYS,U,3))) G PROCQ ;Test account and not an IOC site
; Only IOC TEST sites and all PROD sites get here
I INSTCMP,'$D(IOC($P(SITESYS,U,3))) G PROCQ ;Already installed once and not an IOC site
;
S GREF=$NA(^TMP($J,"IN",1,0))
S SUB=3
;Note: PATH is set up in IBY652E and killed in PROCQ
S FILENAME="va"_$P(SITESYS,U,3)_".txt"
I '$$FTG^%ZISH(PATH,FILENAME,GREF,SUB) G PROCQ
;
;Process MBI Data
S CNT=1,(CCNT,RCNT,SCNT,TCNT)=0
S RCNT=RCNT+1,^TMP($J,"OUT",RCNT,0)="Site:"_$P(SITESYS,U,3)_U_$P(SITESYS,U,2,3)_"^Results of IB*2.0*652 installed on "_$$FMTE^XLFDT(DT)
F S CNT=$O(^TMP($J,"IN",CNT)) Q:'CNT S DATA=^(CNT,0) D
. I '$L(DATA) Q ; blank line at end of file.
. S TCNT=TCNT+1 I '(TCNT#100) U 0 W "."
. N DFN,DOB,ERROR,ICN,ICNT,IEN,INSIEN,MBI,MCNT,SKIP,SSN
. S ICN=$P(DATA,U,1),SSN=$$NOPUNCT^IBCEF($P(DATA,U,2),1),DOB=$$HL7TFM^XLFDT($P(DATA,U,3)),MBI=$P(DATA,U,6)
. S (IEN,MCNT,SKIP)=0
. I MBI']"" D ERROR(DATA,"Patient Not Found") Q
. ;Match on ICN
. I '$D(^DPT("AICN",ICN)) D ERROR(DATA,"Patient Not Found") Q
. S DFN="" F ICNT=0:1 S DFN=$O(^DPT("AICN",ICN,DFN)) I DFN="" Q
. I ICNT'=1 D ERROR(DATA,"Patient Not Found") Q
. S DFN=$O(^DPT("AICN",ICN,""))
. L +^DPT(DFN,.312,0):DILOCKTM E D ERROR(DATA,"Record Locked") Q
. ; Match on SSN
. I $$NOPUNCT^IBCEF($$GET1^DIQ(2,DFN_",",.09),1)'=SSN D ERROR(DATA,"Patient Not Found",1) Q
. ; Match on DOB
. I $$GET1^DIQ(2,DFN_",",.03,"I")'=DOB D ERROR(DATA,"Patient Not Found",1) Q
. ; Check for Medicare policies
. S INSIEN=0
. F S INSIEN=$O(^DPT(DFN,.312,INSIEN)) Q:'INSIEN D
.. N FDA,IENS,INSNM,PATID,SUBID
.. S IENS=INSIEN_","_DFN_","
.. S INSNM=$TR($$GET1^DIQ(2.312,IENS,.01)," ")
.. I ",MEDICARE(WNR),MEDICAREPARTD(WNR),"'[(","_INSNM_",") Q
.. S MCNT=MCNT+1
.. S SUBID=$$GET1^DIQ(2.312,IENS,7.02)
.. S PATID=$$GET1^DIQ(2.312,IENS,5.01)
.. I SUBID=MBI S SKIP=1 Q ;No need to update
.. S SKIP=0
.. ;Set Subscriber ID and Patient ID to MBI,Rollback fields to SUBID AND PATID
.. S FDA(2.312,IENS,5.01)=MBI
.. S FDA(2.312,IENS,7.02)=MBI
.. S FDA(2.312,IENS,7.03)=SUBID
.. S FDA(2.312,IENS,7.04)=PATID
.. S FDA(2.312,IENS,1.05)=DT
.. S FDA(2.312,IENS,1.06)=.5
.. D FILE^DIE(,"FDA","ERROR") I $D(ERROR) D ERROR(DATA,$G(ERROR)) Q
. I SKIP S SCNT=SCNT+1
. I 'MCNT D ERROR(DATA,"No Medicare Found")
. I 'SKIP,MCNT S CCNT=CCNT+1
. L -^DPT(DFN,.312,0)
;
;Write Result file to HMS Directory
S GREF=$NA(^TMP($J,"OUT",1,0))
S FILENAME="va"_$P(SITESYS,U,3)_"-results.txt"
I '$$GTF^%ZISH(GREF,SUB,PATH,FILENAME) G PROCQ
;
N MSG,SUB,XMY
S MSG(1)="On "_$$FMTE^XLFDT(DT)_" the MBI Crosswalk was run at site "_$P(SITESYS,U,3)_" - "_$P(SITESYS,U,2)
S MSG(2)=""
S MSG(3)="Total Records: "_TCNT
S MSG(4)=""
S MSG(5)="Successful Patient Update Records: "_CCNT
S MSG(6)=""
S MSG(7)="Patient Error Records: "_(RCNT-1) ;subtract 1 to account for the header record.
S MSG(8)=""
S MSG(9)="Patient Skipped (MBI correct on file) Records: "_SCNT
S MSG(10)=""
S MSG(11)="File "_FILENAME_" was created in the "_PATH_" directory by user "_$$GET1^DIQ(200,DUZ_",",.01)_"."
;
S SUB="MBI CROSSWALK ("_$P(SITESYS,U,3)_" - "_$P(SITESYS,U,2)_")"
;
S XMY("VHAeInsuranceRapidResponse@domain.ext")=""
;
D MSG^IBCNEUT5(,SUB,"MSG(",1,.XMY)
;
PROCQ ;End of routine.
K PATH,XPDQUIT
Q
;
ERROR(DATA,ERROR,UNLOCK) ;Set the Error in the results file
S RCNT=RCNT+1
S ^TMP($J,"OUT",RCNT,0)=DATA_U_ERROR
I $G(UNLOCK) L -^DPT(DFN,.312,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY652P 4547 printed Dec 13, 2024@02:34:57 Page 2
IBY652P ;AITC/TAZ-Post Install Routine for Patch 652;10 Jun 19
+1 ;;2.0;INTEGRATED BILLING;**652**;21-MAR-94;Build 23
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 NEW IBXPD,XPDIDTOT
+5 SET XPDIDTOT=1
+6 ;
+7 ;
+8 ; Task PROC
+9 DO PROC(1)
+10 ;
+11 ; Done...
+12 DO MES^XPDUTL("")
+13 DO MES^XPDUTL("POST-Install Completed.")
+14 QUIT
+15 ;
PROC(IBXPD) ;Process the MBI File
+1 ;Read File into the ^TMP($J) global
+2 NEW CNT,CCNT,FILENAME,INSTCMP,IOC,GREF,PROD,RCNT,SCNT,SITE,SITESYS,SUB,TCNT
+3 ;
+4 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+5 DO MES^XPDUTL("-------------")
+6 DO MES^XPDUTL("Processing MBI Crosswalk ... ")
+7 ;
+8 KILL ^TMP($JOB)
+9 ;
+10 SET SITESYS=$$SITE^VASITE
+11 ;
+12 ;Past the compliance date, no longer processing files.
IF (DT>3200131)
GOTO PROCQ
+13 ;
+14 ;If site is Manila, DO NOT process
IF $PIECE(SITESYS,U,3)=358
GOTO PROCQ
+15 ;
+16 SET PROD=$$PROD^XUPROD(1)
+17 SET INSTCMP=$$GET1^DIQ(9.7,$ORDER(^XPD(9.7,"B","IB*2.0*652",""),-1)_",",.02,"I")=3
+18 FOR SITE=405,515,518,585,662
SET IOC(SITE)=""
+19 ;
+20 ;Test account and not an IOC site
IF 'PROD
IF '$DATA(IOC($PIECE(SITESYS,U,3)))
GOTO PROCQ
+21 ; Only IOC TEST sites and all PROD sites get here
+22 ;Already installed once and not an IOC site
IF INSTCMP
IF '$DATA(IOC($PIECE(SITESYS,U,3)))
GOTO PROCQ
+23 ;
+24 SET GREF=$NAME(^TMP($JOB,"IN",1,0))
+25 SET SUB=3
+26 ;Note: PATH is set up in IBY652E and killed in PROCQ
+27 SET FILENAME="va"_$PIECE(SITESYS,U,3)_".txt"
+28 IF '$$FTG^%ZISH(PATH,FILENAME,GREF,SUB)
GOTO PROCQ
+29 ;
+30 ;Process MBI Data
+31 SET CNT=1
SET (CCNT,RCNT,SCNT,TCNT)=0
+32 SET RCNT=RCNT+1
SET ^TMP($JOB,"OUT",RCNT,0)="Site:"_$PIECE(SITESYS,U,3)_U_$PIECE(SITESYS,U,2,3)_"^Results of IB*2.0*652 installed on "_$$FMTE^XLFDT(DT)
+33 FOR
SET CNT=$ORDER(^TMP($JOB,"IN",CNT))
if 'CNT
QUIT
SET DATA=^(CNT,0)
Begin DoDot:1
+34 ; blank line at end of file.
IF '$LENGTH(DATA)
QUIT
+35 SET TCNT=TCNT+1
IF '(TCNT#100)
USE 0
WRITE "."
+36 NEW DFN,DOB,ERROR,ICN,ICNT,IEN,INSIEN,MBI,MCNT,SKIP,SSN
+37 SET ICN=$PIECE(DATA,U,1)
SET SSN=$$NOPUNCT^IBCEF($PIECE(DATA,U,2),1)
SET DOB=$$HL7TFM^XLFDT($PIECE(DATA,U,3))
SET MBI=$PIECE(DATA,U,6)
+38 SET (IEN,MCNT,SKIP)=0
+39 IF MBI']""
DO ERROR(DATA,"Patient Not Found")
QUIT
+40 ;Match on ICN
+41 IF '$DATA(^DPT("AICN",ICN))
DO ERROR(DATA,"Patient Not Found")
QUIT
+42 SET DFN=""
FOR ICNT=0:1
SET DFN=$ORDER(^DPT("AICN",ICN,DFN))
IF DFN=""
QUIT
+43 IF ICNT'=1
DO ERROR(DATA,"Patient Not Found")
QUIT
+44 SET DFN=$ORDER(^DPT("AICN",ICN,""))
+45 LOCK +^DPT(DFN,.312,0):DILOCKTM
IF '$TEST
DO ERROR(DATA,"Record Locked")
QUIT
+46 ; Match on SSN
+47 IF $$NOPUNCT^IBCEF($$GET1^DIQ(2,DFN_",",.09),1)'=SSN
DO ERROR(DATA,"Patient Not Found",1)
QUIT
+48 ; Match on DOB
+49 IF $$GET1^DIQ(2,DFN_",",.03,"I")'=DOB
DO ERROR(DATA,"Patient Not Found",1)
QUIT
+50 ; Check for Medicare policies
+51 SET INSIEN=0
+52 FOR
SET INSIEN=$ORDER(^DPT(DFN,.312,INSIEN))
if 'INSIEN
QUIT
Begin DoDot:2
+53 NEW FDA,IENS,INSNM,PATID,SUBID
+54 SET IENS=INSIEN_","_DFN_","
+55 SET INSNM=$TRANSLATE($$GET1^DIQ(2.312,IENS,.01)," ")
+56 IF ",MEDICARE(WNR),MEDICAREPARTD(WNR),"'[(","_INSNM_",")
QUIT
+57 SET MCNT=MCNT+1
+58 SET SUBID=$$GET1^DIQ(2.312,IENS,7.02)
+59 SET PATID=$$GET1^DIQ(2.312,IENS,5.01)
+60 ;No need to update
IF SUBID=MBI
SET SKIP=1
QUIT
+61 SET SKIP=0
+62 ;Set Subscriber ID and Patient ID to MBI,Rollback fields to SUBID AND PATID
+63 SET FDA(2.312,IENS,5.01)=MBI
+64 SET FDA(2.312,IENS,7.02)=MBI
+65 SET FDA(2.312,IENS,7.03)=SUBID
+66 SET FDA(2.312,IENS,7.04)=PATID
+67 SET FDA(2.312,IENS,1.05)=DT
+68 SET FDA(2.312,IENS,1.06)=.5
+69 DO FILE^DIE(,"FDA","ERROR")
IF $DATA(ERROR)
DO ERROR(DATA,$GET(ERROR))
QUIT
End DoDot:2
+70 IF SKIP
SET SCNT=SCNT+1
+71 IF 'MCNT
DO ERROR(DATA,"No Medicare Found")
+72 IF 'SKIP
IF MCNT
SET CCNT=CCNT+1
+73 LOCK -^DPT(DFN,.312,0)
End DoDot:1
+74 ;
+75 ;Write Result file to HMS Directory
+76 SET GREF=$NAME(^TMP($JOB,"OUT",1,0))
+77 SET FILENAME="va"_$PIECE(SITESYS,U,3)_"-results.txt"
+78 IF '$$GTF^%ZISH(GREF,SUB,PATH,FILENAME)
GOTO PROCQ
+79 ;
+80 NEW MSG,SUB,XMY
+81 SET MSG(1)="On "_$$FMTE^XLFDT(DT)_" the MBI Crosswalk was run at site "_$PIECE(SITESYS,U,3)_" - "_$PIECE(SITESYS,U,2)
+82 SET MSG(2)=""
+83 SET MSG(3)="Total Records: "_TCNT
+84 SET MSG(4)=""
+85 SET MSG(5)="Successful Patient Update Records: "_CCNT
+86 SET MSG(6)=""
+87 ;subtract 1 to account for the header record.
SET MSG(7)="Patient Error Records: "_(RCNT-1)
+88 SET MSG(8)=""
+89 SET MSG(9)="Patient Skipped (MBI correct on file) Records: "_SCNT
+90 SET MSG(10)=""
+91 SET MSG(11)="File "_FILENAME_" was created in the "_PATH_" directory by user "_$$GET1^DIQ(200,DUZ_",",.01)_"."
+92 ;
+93 SET SUB="MBI CROSSWALK ("_$PIECE(SITESYS,U,3)_" - "_$PIECE(SITESYS,U,2)_")"
+94 ;
+95 SET XMY("VHAeInsuranceRapidResponse@domain.ext")=""
+96 ;
+97 DO MSG^IBCNEUT5(,SUB,"MSG(",1,.XMY)
+98 ;
PROCQ ;End of routine.
+1 KILL PATH,XPDQUIT
+2 QUIT
+3 ;
ERROR(DATA,ERROR,UNLOCK) ;Set the Error in the results file
+1 SET RCNT=RCNT+1
+2 SET ^TMP($JOB,"OUT",RCNT,0)=DATA_U_ERROR
+3 IF $GET(UNLOCK)
LOCK -^DPT(DFN,.312,0)
+4 QUIT
