Routine: IBY652P

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.")

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

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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY652P   4547     printed  Mar 13, 2025@21:40:07                                                                                                                                                                                                     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

IBY652P.m