- IB20P213 ;ISP/TJH - ENVIRONMENT CHECK WITH PRE-INIT CODE ;04/24/2003
- ;;2.0;INTEGRATED BILLING;**213**;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("R0SC","R0SC^IB20P213")
- S %=$$NEWCP^XPDUTL("NAMES","NAMES^IB20P213")
- Q
- ;
- R0SC ; add a new report type to file 361.2
- ; Name=R0SC ; Description=PROF. GOV'T PAYER EDITS
- ; Disposition=MAIL REPORT TO MAIL GROUP
- N IBA,IBERRM
- I $$FIND1^DIC(361.2,"","X","R0SC","B") D Q
- . D BMES^XPDUTL("R0SC report already in file. No action taken.")
- D BMES^XPDUTL("Adding R0SC report to file 361.2.")
- S IBA(361.2,"+1,",.01)="R0SC" ; new report name
- S IBA(361.2,"+1,",.02)=1 ; internal value 1 = Mail report to mail group
- S IBA(361.2,"+1,",.03)="PROF. GOV'T PAYER EDITS" ; description
- D UPDATE^DIE("","IBA","","IBERRM") ; file a new record
- I $D(IBERRM) D Q ; no reason for this to happen but just in case...
- . K IBA
- . S IBA(1)="WARNING: Unable to add the R0SC report."
- . S IBA(2)=" The following error message was recorded."
- . S IBA(3)=IBERRM("DIERR",1,"TEXT",1)
- . D BMES^XPDUTL(.IBA)
- D COMPLETE
- Q
- ;
- NAMES ; change names of reports per request from EDI group
- D BMES^XPDUTL("Filing new names for six of the Electronic Reports")
- N IBA,IBERRM,IBIEN,IBNA,IBRT
- S IBNA("R022")="PROV DAILY STATS ACCEPT/REJECT"
- S IBNA("R0EX")="INST. GOV'T PAYER EDITS"
- S IBNA("R0N9")="INST. GOV'T WEBMD EDITS"
- S IBNA("R0SA")="PROF. GOV'T WEBMD ACCEPTANCE"
- S IBNA("R0SR")="PROF. GOV'T WEBMD REJECTS"
- S IBNA("R0SS")="PROF. GOV'T WEBMD EDITS"
- S IBRT=0 F Q:IBRT="" D
- . S IBRT=$O(IBNA(IBRT)) Q:IBRT=""
- . S IBIEN=+$$FIND1^DIC(361.2,"","X",IBRT,"B")
- . I 'IBIEN D BMES^XPDUTL("Report "_IBRT_" not found. No change made.") Q
- . S IBA(361.2,IBIEN_",",.03)=IBNA(IBRT)
- D FILE^DIE("","IBA","IBERRM")
- D COMPLETE
- Q
- ;
- COMPLETE ; display message that step has completed
- D BMES^XPDUTL("Step complete.")
- Q
- ;
- END ; display message that pre-init has completed successfully
- D BMES^XPDUTL("Pre-init complete")
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P213 2122 printed Mar 13, 2025@21:06:38 Page 2
- IB20P213 ;ISP/TJH - ENVIRONMENT CHECK WITH PRE-INIT CODE ;04/24/2003
- +1 ;;2.0;INTEGRATED BILLING;**213**;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("R0SC","R0SC^IB20P213")
- +3 SET %=$$NEWCP^XPDUTL("NAMES","NAMES^IB20P213")
- +4 QUIT
- +5 ;
- R0SC ; add a new report type to file 361.2
- +1 ; Name=R0SC ; Description=PROF. GOV'T PAYER EDITS
- +2 ; Disposition=MAIL REPORT TO MAIL GROUP
- +3 NEW IBA,IBERRM
- +4 IF $$FIND1^DIC(361.2,"","X","R0SC","B")
- Begin DoDot:1
- +5 DO BMES^XPDUTL("R0SC report already in file. No action taken.")
- End DoDot:1
- QUIT
- +6 DO BMES^XPDUTL("Adding R0SC report to file 361.2.")
- +7 ; new report name
- SET IBA(361.2,"+1,",.01)="R0SC"
- +8 ; internal value 1 = Mail report to mail group
- SET IBA(361.2,"+1,",.02)=1
- +9 ; description
- SET IBA(361.2,"+1,",.03)="PROF. GOV'T PAYER EDITS"
- +10 ; file a new record
- DO UPDATE^DIE("","IBA","","IBERRM")
- +11 ; no reason for this to happen but just in case...
- IF $DATA(IBERRM)
- Begin DoDot:1
- +12 KILL IBA
- +13 SET IBA(1)="WARNING: Unable to add the R0SC report."
- +14 SET IBA(2)=" The following error message was recorded."
- +15 SET IBA(3)=IBERRM("DIERR",1,"TEXT",1)
- +16 DO BMES^XPDUTL(.IBA)
- End DoDot:1
- QUIT
- +17 DO COMPLETE
- +18 QUIT
- +19 ;
- NAMES ; change names of reports per request from EDI group
- +1 DO BMES^XPDUTL("Filing new names for six of the Electronic Reports")
- +2 NEW IBA,IBERRM,IBIEN,IBNA,IBRT
- +3 SET IBNA("R022")="PROV DAILY STATS ACCEPT/REJECT"
- +4 SET IBNA("R0EX")="INST. GOV'T PAYER EDITS"
- +5 SET IBNA("R0N9")="INST. GOV'T WEBMD EDITS"
- +6 SET IBNA("R0SA")="PROF. GOV'T WEBMD ACCEPTANCE"
- +7 SET IBNA("R0SR")="PROF. GOV'T WEBMD REJECTS"
- +8 SET IBNA("R0SS")="PROF. GOV'T WEBMD EDITS"
- +9 SET IBRT=0
- FOR
- if IBRT=""
- QUIT
- Begin DoDot:1
- +10 SET IBRT=$ORDER(IBNA(IBRT))
- if IBRT=""
- QUIT
- +11 SET IBIEN=+$$FIND1^DIC(361.2,"","X",IBRT,"B")
- +12 IF 'IBIEN
- DO BMES^XPDUTL("Report "_IBRT_" not found. No change made.")
- QUIT
- +13 SET IBA(361.2,IBIEN_",",.03)=IBNA(IBRT)
- End DoDot:1
- +14 DO FILE^DIE("","IBA","IBERRM")
- +15 DO COMPLETE
- +16 QUIT
- +17 ;
- COMPLETE ; display message that step has completed
- +1 DO BMES^XPDUTL("Step complete.")
- +2 QUIT
- +3 ;
- END ; display message that pre-init has completed successfully
- +1 DO BMES^XPDUTL("Pre-init complete")
- +2 QUIT
- +3 ;