IBY595PO.m

IBY595PO ;EDE/DM - Post-Installation for IB patch 595 ; 01-APR-2018

 ;;2.0;INTEGRATED BILLING;**595**;21-MAR-94;Build 29

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

POST ; POST ROUTINE(S)

 N IBXPD,XPDIDTOT

 S XPDIDTOT=2

 ;

 ; Add new Source of Information

 D ADDSOI(1)

 ;

 ; Make sure the "AUTOUPDATE,IBEIV" PERSON exists

 D CHKAU(2)

 ;

 D MES^XPDUTL("")

 D MES^XPDUTL("POST-Install Completed.")

 Q

 ;

ADDSOI(IBXPD) ; Add new Source of Information.

 N IBLN,IBPCE,IBDATA,IBERR,IBIEN,IBSTR

 D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)

 D MES^XPDUTL("-------------")

 D MES^XPDUTL("Adding new Source of Information Codes ... ")

 F IBLN=2:1 S IBSTR=$P($T(EN35512+IBLN),";;",2) Q:IBSTR=""  D

 . F IBPCE=1:1:3 S IBDATA(IBPCE/100)=$P(IBSTR,U,IBPCE)

 . I $D(^IBE(355.12,"C",IBDATA(.02))) D  Q

 .. D MES^XPDUTL("  "_IBDATA(.02)_" ALEADY EXISTS IN THE SOURCE OF INFORMATION TABLE (#355.12)") Q

 . S IBIEN=$$ADD^IBDFDBS(355.12,,.IBDATA,.IBERR)

 . I IBERR D  Q

 .. D BMES^XPDUTL("*** ERROR ADDING "_IBDATA(.02)_" CODE TO THE SOURCE OF INFORMATION TABLE (#355.12) ***")

 . D BMES^XPDUTL("  "_$$GET1^DIQ(355.12,IBIEN_",",.02)_" CODE ADDED TO THE SOURCE OF INFORMATION TABLE (#355.12)")

 D MES^XPDUTL("STEP "_IBXPD_" of "_XPDIDTOT_" COMPLETE")

 Q

 ;

CHKAU(IBXPD) ; Make sure the "AUTOUPDATE,IBEIV" PERSON exists in #200

 N IEN200,IBAUNAME

 S IBAUNAME="AUTOUPDATE,IBEIV"

 D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)

 D MES^XPDUTL("-------------")

 D MES^XPDUTL("Checking for "_IBAUNAME_" in the New Person file (#200) ... ")

 ; Supported by IA#4677.

 S IEN200=$$CREATE^XUSAP(IBAUNAME,"")

 I +IEN200=0 D MES^XPDUTL("  "_IBAUNAME_" exists.")

 I +IEN200>0 D MES^XPDUTL("  "_IBAUNAME_" added.")

 I IEN200<0 D MES^XPDUTL("*(ERROR) "_IBAUNAME_" NOT added.")

 D MES^XPDUTL("STEP "_IBXPD_" of "_XPDIDTOT_" COMPLETE")

 Q

 ;

EN35512  ; Add Source of Information Codes

 ;

 ;;20^MYVA HEALTH JOURNAL^MVAH

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBY595PO   1953     printed  Apr 09, 2024@21:25:04                                                                                                                                                                                                    Page 2

IBY595PO  ;EDE/DM - Post-Installation for IB patch 595 ; 01-APR-2018

 +1       ;;2.0;INTEGRATED BILLING;**595**;21-MAR-94;Build 29

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

POST      ; POST ROUTINE(S)

 +1        NEW IBXPD,XPDIDTOT

 +2        SET XPDIDTOT=2

 +3       ;

 +4       ; Add new Source of Information

 +5        DO ADDSOI(1)

 +6       ;

 +7       ; Make sure the "AUTOUPDATE,IBEIV" PERSON exists

 +8        DO CHKAU(2)

 +9       ;

 +10       DO MES^XPDUTL("")

 +11       DO MES^XPDUTL("POST-Install Completed.")

 +12       QUIT 

 +13      ;

ADDSOI(IBXPD) ; Add new Source of Information.

 +1        NEW IBLN,IBPCE,IBDATA,IBERR,IBIEN,IBSTR

 +2        DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)

 +3        DO MES^XPDUTL("-------------")

 +4        DO MES^XPDUTL("Adding new Source of Information Codes ... ")

 +5        FOR IBLN=2:1

               SET IBSTR=$PIECE($TEXT(EN35512+IBLN),";;",2)

               if IBSTR=""

                   QUIT 

               Begin DoDot:1

 +6                FOR IBPCE=1:1:3

                       SET IBDATA(IBPCE/100)=$PIECE(IBSTR,U,IBPCE)

 +7                IF $DATA(^IBE(355.12,"C",IBDATA(.02)))

                       Begin DoDot:2

 +8                        DO MES^XPDUTL("  "_IBDATA(.02)_" ALEADY EXISTS IN THE SOURCE OF INFORMATION TABLE (#355.12)")

                           QUIT 

                       End DoDot:2

                       QUIT 

 +9                SET IBIEN=$$ADD^IBDFDBS(355.12,,.IBDATA,.IBERR)

 +10               IF IBERR

                       Begin DoDot:2

 +11                       DO BMES^XPDUTL("*** ERROR ADDING "_IBDATA(.02)_" CODE TO THE SOURCE OF INFORMATION TABLE (#355.12) ***")

                       End DoDot:2

                       QUIT 

 +12               DO BMES^XPDUTL("  "_$$GET1^DIQ(355.12,IBIEN_",",.02)_" CODE ADDED TO THE SOURCE OF INFORMATION TABLE (#355.12)")

               End DoDot:1

 +13       DO MES^XPDUTL("STEP "_IBXPD_" of "_XPDIDTOT_" COMPLETE")

 +14       QUIT 

 +15      ;

CHKAU(IBXPD) ; Make sure the "AUTOUPDATE,IBEIV" PERSON exists in #200

 +1        NEW IEN200,IBAUNAME

 +2        SET IBAUNAME="AUTOUPDATE,IBEIV"

 +3        DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)

 +4        DO MES^XPDUTL("-------------")

 +5        DO MES^XPDUTL("Checking for "_IBAUNAME_" in the New Person file (#200) ... ")

 +6       ; Supported by IA#4677.

 +7        SET IEN200=$$CREATE^XUSAP(IBAUNAME,"")

 +8        IF +IEN200=0

               DO MES^XPDUTL("  "_IBAUNAME_" exists.")

 +9        IF +IEN200>0

               DO MES^XPDUTL("  "_IBAUNAME_" added.")

 +10       IF IEN200<0

               DO MES^XPDUTL("*(ERROR) "_IBAUNAME_" NOT added.")

 +11       DO MES^XPDUTL("STEP "_IBXPD_" of "_XPDIDTOT_" COMPLETE")

 +12       QUIT 

 +13      ;

EN35512   ; Add Source of Information Codes

 +1       ;

 +2       ;;20^MYVA HEALTH JOURNAL^MVAH