- 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 ---[H[J[2J[HIBY595PO 1953 printed Jan 18, 2025@03:35:55 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