IB20P212 ;ISP/TJH - ENVIRONMENT CHECK WITH PRE-INIT CODE for IB*2.0*212 ;04/02/2003
;;2.0;INTEGRATED BILLING;**212**;21-MAR-94
;
ENV ; environment check
; No special environment check at this time.
PRE ; set up check points for pre-init
N %
S %=$$NEWCP^XPDUTL("R3","R3^IB20P212")
Q
;
R3 ; set new value into record 3 of file 355.97, re: IND-0902-42308
; change the SOURCE LEVEL MINIMUM for CHAMPUS ID to NONE
D BMES^XPDUTL("Updating SOURCE LEVEL MINIMUM for CHAMPUS ID.")
N DA,IBFL,IBROOT,IBERR
S DA=""
I $D(^IBE(355.97,"B","CHAMPUS ID")) S DA=$O(^IBE(355.97,"B","CHAMPUS ID",""))
I DA="" D ERRMSG("CHAMPUS ID record not found") G EXIT
S IBFL="",IBROOT(355.97,DA_",",.02)=0
D FILE^DIE(IBFL,"IBROOT","IBERR")
I $D(IBERR("DIERR")) D ERRMSG(IBERR("DIERR",1,"TEXT",1)) G EXIT
D BMES^XPDUTL("Pre-init completed successfully.")
EXIT Q
;
ERRMSG(TXT) ; Write error message
D BMES^XPDUTL("Update failed. "_TXT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P212 952 printed Dec 13, 2024@02:01:51 Page 2
IB20P212 ;ISP/TJH - ENVIRONMENT CHECK WITH PRE-INIT CODE for IB*2.0*212 ;04/02/2003
+1 ;;2.0;INTEGRATED BILLING;**212**;21-MAR-94
+2 ;
ENV ; environment check
+1 ; No special environment check at this time.
PRE ; set up check points for pre-init
+1 NEW %
+2 SET %=$$NEWCP^XPDUTL("R3","R3^IB20P212")
+3 QUIT
+4 ;
R3 ; set new value into record 3 of file 355.97, re: IND-0902-42308
+1 ; change the SOURCE LEVEL MINIMUM for CHAMPUS ID to NONE
+2 DO BMES^XPDUTL("Updating SOURCE LEVEL MINIMUM for CHAMPUS ID.")
+3 NEW DA,IBFL,IBROOT,IBERR
+4 SET DA=""
+5 IF $DATA(^IBE(355.97,"B","CHAMPUS ID"))
SET DA=$ORDER(^IBE(355.97,"B","CHAMPUS ID",""))
+6 IF DA=""
DO ERRMSG("CHAMPUS ID record not found")
GOTO EXIT
+7 SET IBFL=""
SET IBROOT(355.97,DA_",",.02)=0
+8 DO FILE^DIE(IBFL,"IBROOT","IBERR")
+9 IF $DATA(IBERR("DIERR"))
DO ERRMSG(IBERR("DIERR",1,"TEXT",1))
GOTO EXIT
+10 DO BMES^XPDUTL("Pre-init completed successfully.")
EXIT QUIT
+1 ;
ERRMSG(TXT) ; Write error message
+1 DO BMES^XPDUTL("Update failed. "_TXT)
+2 QUIT
