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 Dec 13, 2024@02:34:44 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
