IB20P212.m

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 ---IB20P212   952     printed  Apr 09, 2024@21:33: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